plsql/step2_eval.sql

   1 @io.sql
   2 @types.sql
   3 @reader.sql
   4 @printer.sql
   5
   6 CREATE OR REPLACE PACKAGE mal IS
   7
   8 FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer;
   9
  10 END mal;
  11 /
  12
  13 CREATE OR REPLACE PACKAGE BODY mal IS
  14
  15 FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS
  16     M         types.mal_table;                 -- general mal value memory pool
  17     H         types.map_entry_table;    -- hashmap memory pool
  18     TYPE      env_T IS TABLE OF integer INDEX BY varchar2(100);
  19     repl_env  env_T;
  20     line      CLOB;
  21
  22     -- read
  23     FUNCTION READ(line varchar) RETURN integer IS
  24     BEGIN
  25         RETURN reader.read_str(M, H, line);
  26     END;
  27
  28     -- eval
  29
  30     -- forward declarations
  31     FUNCTION EVAL(ast integer, env env_T) RETURN integer;
  32     FUNCTION do_core_func(fn integer, args mal_vals)
  33         RETURN integer;
  34
  35     FUNCTION eval_ast(ast integer, env env_T) RETURN integer IS
  36         i         integer;
  37         old_seq   mal_vals;
  38         new_seq   mal_vals;
  39         new_hm    integer;
  40         old_midx  integer;
  41         new_midx  integer;
  42         k         varchar2(256);
  43     BEGIN
  44         IF M(ast).type_id = 7 THEN
  45             RETURN env(TREAT(M(ast) AS mal_str_T).val_str);
  46         ELSIF M(ast).type_id IN (8,9) THEN
  47             old_seq := TREAT(M(ast) AS mal_seq_T).val_seq;
  48             new_seq := mal_vals();
  49             new_seq.EXTEND(old_seq.COUNT);
  50             FOR i IN 1..old_seq.COUNT LOOP
  51                 new_seq(i) := EVAL(old_seq(i), env);
  52             END LOOP;
  53             RETURN types.seq(M, M(ast).type_id, new_seq);
  54         ELSIF M(ast).type_id IN (10) THEN
  55             new_hm := types.hash_map(M, H, mal_vals());
  56             old_midx := TREAT(M(ast) AS mal_map_T).map_idx;
  57             new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx;
  58
  59             k := H(old_midx).FIRST();
  60             WHILE k IS NOT NULL LOOP
  61                 H(new_midx)(k) := EVAL(H(old_midx)(k), env);
  62                 k := H(old_midx).NEXT(k);
  63             END LOOP;
  64             RETURN new_hm;
  65         ELSE
  66             RETURN ast;
  67         END IF;
  68     END;
  69
  70     FUNCTION EVAL(ast integer, env env_T) RETURN integer IS
  71         el       integer;
  72         f        integer;
  73         args     mal_vals;
  74     BEGIN
  75         IF M(ast).type_id <> 8 THEN
  76             RETURN eval_ast(ast, env);
  77         END IF;
  78         IF types.count(M, ast) = 0 THEN
  79             RETURN ast; -- empty list just returned
  80         END IF;
  81
  82         -- apply
  83         el := eval_ast(ast, env);
  84         f := types.first(M, el);
  85         args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_T).val_seq;
  86         RETURN do_core_func(f, args);
  87     END;
  88
  89     -- print
  90     FUNCTION PRINT(exp integer) RETURN varchar IS
  91     BEGIN
  92         RETURN printer.pr_str(M, H, exp);
  93     END;
  94
  95     -- repl
  96     FUNCTION mal_add(args mal_vals) RETURN integer IS
  97     BEGIN
  98         RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int +
  99                             TREAT(M(args(2)) AS mal_int_T).val_int);
 100     END;
 101
 102     FUNCTION mal_subtract(args mal_vals) RETURN integer IS
 103     BEGIN
 104         RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int -
 105                             TREAT(M(args(2)) AS mal_int_T).val_int);
 106     END;
 107
 108     FUNCTION mal_multiply(args mal_vals) RETURN integer IS
 109     BEGIN
 110         RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int *
 111                             TREAT(M(args(2)) AS mal_int_T).val_int);
 112     END;
 113
 114     FUNCTION mal_divide(args mal_vals) RETURN integer IS
 115     BEGIN
 116         RETURN types.int(M, TREAT(M(args(1)) AS mal_int_T).val_int /
 117                             TREAT(M(args(2)) AS mal_int_T).val_int);
 118     END;
 119
 120     FUNCTION do_core_func(fn integer, args mal_vals)
 121         RETURN integer IS
 122         fname  varchar(256);
 123     BEGIN
 124         IF M(fn).type_id <> 11 THEN
 125             raise_application_error(-20004,
 126                 'Invalid function call', TRUE);
 127         END IF;
 128
 129         fname := TREAT(M(fn) AS mal_str_T).val_str;
 130         CASE
 131         WHEN fname = '+' THEN RETURN mal_add(args);
 132         WHEN fname = '-' THEN RETURN mal_subtract(args);
 133         WHEN fname = '*' THEN RETURN mal_multiply(args);
 134         WHEN fname = '/' THEN RETURN mal_divide(args);
 135         ELSE raise_application_error(-20004,
 136                 'Invalid function call', TRUE);
 137         END CASE;
 138     END;
 139
 140     FUNCTION REP(line varchar) RETURN varchar IS
 141     BEGIN
 142         RETURN PRINT(EVAL(READ(line), repl_env));
 143     END;
 144
 145 BEGIN
 146     -- initialize memory pools
 147     M := types.mem_new();
 148     H := types.map_entry_table();
 149
 150     repl_env('+') := types.func(M, '+');
 151     repl_env('-') := types.func(M, '-');
 152     repl_env('*') := types.func(M, '*');
 153     repl_env('/') := types.func(M, '/');
 154
 155     WHILE true LOOP
 156         BEGIN
 157             line := io.readline('user> ', 0);
 158             IF line = EMPTY_CLOB() THEN CONTINUE; END IF;
 159             IF line IS NOT NULL THEN
 160                 io.writeline(REP(line));
 161             END IF;
 162
 163             EXCEPTION WHEN OTHERS THEN
 164                 IF SQLCODE = -20001 THEN  -- io read stream closed
 165                     io.close(1);  -- close output stream
 166                     RETURN 0;
 167                 END IF;
 168                 io.writeline('Error: ' || SQLERRM);
 169                 io.writeline(dbms_utility.format_error_backtrace);
 170         END;
 171     END LOOP;
 172 END;
 173
 174 END mal;
 175 /
 176 show errors;
 177
 178 quit;