impls/plsql/step4_if_fn_do.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(ast integer, 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(ast integer, env integer) RETURN integer IS
  74         el       integer;
  75         a0       integer;
  76         a0sym    varchar2(100);
  77         seq      mal_vals;
  78         let_env  integer;
  79         i        integer;
  80         f        integer;
  81         fn_env   integer;
  82         cond     integer;
  83         malfn    mal_func_T;
  84         args     mal_vals;
  85     BEGIN
  86         IF M(ast).type_id <> 8 THEN
  87             RETURN eval_ast(ast, env);
  88         END IF;
  89         IF types.count(M, ast) = 0 THEN
  90             RETURN ast; -- empty list just returned
  91         END IF;
  92
  93         -- apply
  94         a0 := types.first(M, ast);
  95         if M(a0).type_id = 7 THEN -- symbol
  96             a0sym := TREAT(M(a0) AS mal_str_T).val_str;
  97         ELSE
  98             a0sym := '__<*fn*>__';
  99         END IF;
 100
 101         CASE
 102         WHEN a0sym = 'def!' THEN
 103             RETURN env_pkg.env_set(M, E, env,
 104                 types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env));
 105         WHEN a0sym = 'let*' THEN
 106             let_env := env_pkg.env_new(M, E, env);
 107             seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_T).val_seq;
 108             i := 1;
 109             WHILE i <= seq.COUNT LOOP
 110                 x := env_pkg.env_set(M, E, let_env,
 111                     seq(i), EVAL(seq(i+1), let_env));
 112                 i := i + 2;
 113             END LOOP;
 114             RETURN EVAL(types.nth(M, ast, 2), let_env);
 115         WHEN a0sym = 'do' THEN
 116             el := eval_ast(types.slice(M, ast, 1), env);
 117             RETURN types.nth(M, el, types.count(M, el)-1);
 118         WHEN a0sym = 'if' THEN
 119             cond := EVAL(types.nth(M, ast, 1), env);
 120             IF cond = 1 OR cond = 2 THEN  -- nil or false
 121                 IF types.count(M, ast) > 3 THEN
 122                     RETURN EVAL(types.nth(M, ast, 3), env);
 123                 ELSE
 124                     RETURN 1;  -- nil
 125                 END IF;
 126             ELSE
 127                 RETURN EVAL(types.nth(M, ast, 2), env);
 128             END IF;
 129         WHEN a0sym = 'fn*' THEN
 130             RETURN types.malfunc(M, types.nth(M, ast, 2),
 131                                     types.nth(M, ast, 1),
 132                                     env);
 133         ELSE
 134             el := eval_ast(ast, env);
 135             f := types.first(M, el);
 136             args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq;
 137             IF M(f).type_id = 12 THEN
 138                 malfn := TREAT(M(f) AS mal_func_T);
 139                 fn_env := env_pkg.env_new(M, E, malfn.env,
 140                                           malfn.params, args);
 141                 RETURN EVAL(malfn.ast, fn_env);
 142             ELSE
 143                 RETURN core.do_core_func(M, H, f, args);
 144             END IF;
 145         END CASE;
 146
 147     END;
 148
 149     -- print
 150     FUNCTION PRINT(exp integer) RETURN varchar IS
 151     BEGIN
 152         RETURN printer.pr_str(M, H, exp);
 153     END;
 154
 155     -- repl
 156     FUNCTION REP(line varchar) RETURN varchar IS
 157     BEGIN
 158         RETURN PRINT(EVAL(READ(line), repl_env));
 159     END;
 160
 161 BEGIN
 162     -- initialize memory pools
 163     M := types.mem_new();
 164     H := types.map_entry_table();
 165     E := env_pkg.env_entry_table();
 166
 167     repl_env := env_pkg.env_new(M, E, NULL);
 168
 169     -- core.EXT: defined using PL/SQL
 170     core_ns := core.get_core_ns();
 171     FOR cidx IN 1..core_ns.COUNT LOOP
 172         x := env_pkg.env_set(M, E, repl_env,
 173             types.symbol(M, core_ns(cidx)),
 174             types.func(M, core_ns(cidx)));
 175     END LOOP;
 176
 177     -- core.mal: defined using the language itself
 178     line := REP('(def! not (fn* (a) (if a false true)))');
 179
 180     WHILE true LOOP
 181         BEGIN
 182             line := io.readline('user> ', 0);
 183             IF line = EMPTY_CLOB() THEN CONTINUE; END IF;
 184             IF line IS NOT NULL THEN
 185                 io.writeline(REP(line));
 186             END IF;
 187
 188             EXCEPTION WHEN OTHERS THEN
 189                 IF SQLCODE = -20001 THEN  -- io read stream closed
 190                     io.close(1);  -- close output stream
 191                     RETURN 0;
 192                 END IF;
 193                 io.writeline('Error: ' || SQLERRM);
 194                 io.writeline(dbms_utility.format_error_backtrace);
 195         END;
 196     END LOOP;
 197 END;
 198
 199 END mal;
 200 /
 201 show errors;
 202
 203 quit;