plsql/step5_tco.sql

   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
  10 FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer;
  11
  12 END mal;
  13 /
  14
  15 CREATE OR REPLACE PACKAGE BODY mal IS
  16
  17 FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS
  18     M         types.mal_table;                 -- general mal value memory pool
  19     H         types.map_entry_table;    -- hashmap memory pool
  20     E         env_pkg.env_entry_table;  -- mal env memory pool
  21     repl_env  integer;
  22     x         integer;
  23     line      CLOB;
  24     core_ns   core_ns_T;
  25     cidx      integer;
  26
  27     -- read
  28     FUNCTION READ(line varchar) RETURN integer IS
  29     BEGIN
  30         RETURN reader.read_str(M, H, line);
  31     END;
  32
  33     -- eval
  34
  35     -- forward declarations
  36     FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer;
  37
  38     FUNCTION eval_ast(ast integer, env integer) RETURN integer IS
  39         i         integer;
  40         old_seq   mal_vals;
  41         new_seq   mal_vals;
  42         new_hm    integer;
  43         old_midx  integer;
  44         new_midx  integer;
  45         k         varchar2(256);
  46     BEGIN
  47         IF M(ast).type_id = 7 THEN
  48             RETURN env_pkg.env_get(M, E, env, ast);
  49         ELSIF M(ast).type_id IN (8,9) THEN
  50             old_seq := TREAT(M(ast) AS mal_seq_T).val_seq;
  51             new_seq := mal_vals();
  52             new_seq.EXTEND(old_seq.COUNT);
  53             FOR i IN 1..old_seq.COUNT LOOP
  54                 new_seq(i) := EVAL(old_seq(i), env);
  55             END LOOP;
  56             RETURN types.seq(M, M(ast).type_id, new_seq);
  57         ELSIF M(ast).type_id IN (10) THEN
  58             new_hm := types.hash_map(M, H, mal_vals());
  59             old_midx := TREAT(M(ast) AS mal_map_T).map_idx;
  60             new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx;
  61
  62             k := H(old_midx).FIRST();
  63             WHILE k IS NOT NULL LOOP
  64                 H(new_midx)(k) := EVAL(H(old_midx)(k), env);
  65                 k := H(old_midx).NEXT(k);
  66             END LOOP;
  67             RETURN new_hm;
  68         ELSE
  69             RETURN ast;
  70         END IF;
  71     END;
  72
  73     FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS
  74         ast      integer := orig_ast;
  75         env      integer := orig_env;
  76         el       integer;
  77         a0       integer;
  78         a0sym    varchar2(100);
  79         seq      mal_vals;
  80         let_env  integer;
  81         i        integer;
  82         f        integer;
  83         cond     integer;
  84         malfn    mal_func_T;
  85         args     mal_vals;
  86     BEGIN
  87       WHILE TRUE LOOP
  88         -- io.writeline('EVAL: ' || printer.pr_str(M, ast));
  89         IF M(ast).type_id <> 8 THEN
  90             RETURN eval_ast(ast, env);
  91         END IF;
  92         IF types.count(M, ast) = 0 THEN
  93             RETURN ast; -- empty list just returned
  94         END IF;
  95
  96         -- apply
  97         a0 := types.first(M, ast);
  98         if M(a0).type_id = 7 THEN -- symbol
  99             a0sym := TREAT(M(a0) AS mal_str_T).val_str;
 100         ELSE
 101             a0sym := '__<*fn*>__';
 102         END IF;
 103
 104         CASE
 105         WHEN a0sym = 'def!' THEN
 106             RETURN env_pkg.env_set(M, E, env,
 107                 types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env));
 108         WHEN a0sym = 'let*' THEN
 109             let_env := env_pkg.env_new(M, E, env);
 110             seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq;
 111             i := 1;
 112             WHILE i <= seq.COUNT LOOP
 113                 x := env_pkg.env_set(M, E, let_env,
 114                     seq(i), EVAL(seq(i+1), let_env));
 115                 i := i + 2;
 116             END LOOP;
 117             env := let_env;
 118             ast := types.nth(M, ast, 2); -- TCO
 119         WHEN a0sym = 'do' THEN
 120             x := types.slice(M, ast, 1, types.count(M, ast)-2);
 121             x := eval_ast(x, env);
 122             ast := types.nth(M, ast, types.count(M, ast)-1);  -- TCO
 123         WHEN a0sym = 'if' THEN
 124             cond := EVAL(types.nth(M, ast, 1), env);
 125             IF cond = 1 OR cond = 2 THEN  -- nil or false
 126                 IF types.count(M, ast) > 3 THEN
 127                     ast := types.nth(M, ast, 3);  -- TCO
 128                 ELSE
 129                     RETURN 1;  -- nil
 130                 END IF;
 131             ELSE
 132                 ast := types.nth(M, ast, 2);  -- TCO
 133             END IF;
 134         WHEN a0sym = 'fn*' THEN
 135             RETURN types.malfunc(M, types.nth(M, ast, 2),
 136                                     types.nth(M, ast, 1),
 137                                     env);
 138         ELSE
 139             el := eval_ast(ast, env);
 140             f := types.first(M, el);
 141             args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq;
 142             IF M(f).type_id = 12 THEN
 143                 malfn := TREAT(M(f) AS mal_func_T);
 144                 env := env_pkg.env_new(M, E, malfn.env,
 145                                           malfn.params, args);
 146                 ast := malfn.ast;  -- TCO
 147             ELSE
 148                 RETURN core.do_core_func(M, H, f, args);
 149             END IF;
 150         END CASE;
 151
 152       END LOOP;
 153
 154     END;
 155
 156     -- print
 157     FUNCTION PRINT(exp integer) RETURN varchar IS
 158     BEGIN
 159         RETURN printer.pr_str(M, H, exp);
 160     END;
 161
 162     -- repl
 163     FUNCTION REP(line varchar) RETURN varchar IS
 164     BEGIN
 165         RETURN PRINT(EVAL(READ(line), repl_env));
 166     END;
 167
 168 BEGIN
 169     -- initialize memory pools
 170     M := types.mem_new();
 171     H := types.map_entry_table();
 172     E := env_pkg.env_entry_table();
 173
 174     repl_env := env_pkg.env_new(M, E, NULL);
 175
 176     -- core.EXT: defined using PL/SQL
 177     core_ns := core.get_core_ns();
 178     FOR cidx IN 1..core_ns.COUNT LOOP
 179         x := env_pkg.env_set(M, E, repl_env,
 180             types.symbol(M, core_ns(cidx)),
 181             types.func(M, core_ns(cidx)));
 182     END LOOP;
 183
 184     -- core.mal: defined using the language itself
 185     line := REP('(def! not (fn* (a) (if a false true)))');
 186
 187     WHILE true LOOP
 188         BEGIN
 189             line := io.readline('user> ', 0);
 190             IF line = EMPTY_CLOB() THEN CONTINUE; END IF;
 191             IF line IS NOT NULL THEN
 192                 io.writeline(REP(line));
 193             END IF;
 194
 195             EXCEPTION WHEN OTHERS THEN
 196                 IF SQLCODE = -20001 THEN  -- io read stream closed
 197                     io.close(1);  -- close output stream
 198                     RETURN 0;
 199                 END IF;
 200                 io.writeline('Error: ' || SQLERRM);
 201                 io.writeline(dbms_utility.format_error_backtrace);
 202         END;
 203     END LOOP;
 204 END;
 205
 206 END mal;
 207 /
 208 show errors;
 209
 210 quit;