plsql/types.sql

   1 -- ---------------------------------------------------------
   2 -- persistent values
   3
   4 BEGIN
   5   EXECUTE IMMEDIATE 'DROP TYPE mal_T FORCE';
   6 EXCEPTION
   7   WHEN OTHERS THEN IF SQLCODE != -4043 THEN RAISE; END IF;
   8 END;
   9 /
  10
  11 -- list of types for type_id
  12 -- 0:  nil
  13 -- 1:  false
  14 -- 2:  true
  15 -- 3:  integer
  16 -- 4:  float
  17 -- 5:  string
  18 -- 6:  long string (CLOB)
  19 -- 7:  symbol
  20 -- 8:  list
  21 -- 9:  vector
  22 -- 10: hashmap
  23 -- 11: function
  24 -- 12: malfunc
  25 -- 13: atom
  26
  27 -- nil (0), false (1), true (2)
  28 CREATE OR REPLACE TYPE mal_T FORCE AS OBJECT (
  29     type_id  integer
  30 ) NOT FINAL;
  31 /
  32
  33 -- general nested table of mal values (integers)
  34 -- used frequently for argument passing
  35 CREATE OR REPLACE TYPE mal_vals FORCE AS TABLE OF integer;
  36 /
  37
  38
  39 -- integer (3)
  40 CREATE OR REPLACE TYPE mal_int_T FORCE UNDER mal_T (
  41     val_int  integer
  42 ) FINAL;
  43 /
  44
  45 -- string/keyword (5,6), symbol (7)
  46 CREATE OR REPLACE TYPE mal_str_T FORCE UNDER mal_T (
  47     val_str  varchar2(4000)
  48 ) NOT FINAL;
  49 /
  50
  51 CREATE OR REPLACE TYPE mal_long_str_T FORCE UNDER mal_str_T (
  52     val_long_str  CLOB  -- long character object (for larger than 4000 chars)
  53 ) FINAL;
  54 /
  55 show errors;
  56
  57 -- list (8), vector (9)
  58 CREATE OR REPLACE TYPE mal_seq_T FORCE UNDER mal_T (
  59     val_seq  mal_vals,
  60     meta     integer
  61 ) FINAL;
  62 /
  63
  64 CREATE OR REPLACE TYPE mal_map_T FORCE UNDER mal_T (
  65     map_idx  integer,  -- index into map entry table
  66     meta     integer
  67 ) FINAL;
  68 /
  69
  70 -- malfunc (12)
  71 CREATE OR REPLACE TYPE mal_func_T FORCE UNDER mal_T (
  72     ast       integer,
  73     params    integer,
  74     env       integer,
  75     is_macro  integer,
  76     meta      integer
  77 ) FINAL;
  78 /
  79
  80 -- atom (13)
  81 CREATE OR REPLACE TYPE mal_atom_T FORCE UNDER mal_T (
  82     val  integer  -- index into mal_table
  83 );
  84 /
  85
  86
  87 -- ---------------------------------------------------------
  88
  89 CREATE OR REPLACE PACKAGE types IS
  90     -- memory pool for mal_objects (non-hash-map)
  91     TYPE mal_table IS TABLE OF mal_T;
  92
  93     -- memory pool for hash-map objects
  94     TYPE map_entry IS TABLE OF integer INDEX BY varchar2(256);
  95     TYPE map_entry_table IS TABLE OF map_entry;
  96
  97     -- general functions
  98     FUNCTION mem_new RETURN mal_table;
  99
 100     FUNCTION tf(val boolean) RETURN integer;
 101     FUNCTION equal_Q(M IN OUT NOCOPY mal_table,
 102                      H IN OUT NOCOPY map_entry_table,
 103                      a integer, b integer) RETURN boolean;
 104
 105     FUNCTION clone(M IN OUT NOCOPY mal_table,
 106                    H IN OUT NOCOPY map_entry_table,
 107                    obj integer,
 108                    meta integer DEFAULT 1) RETURN integer;
 109
 110     -- scalar functions
 111     FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer;
 112     FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer;
 113     FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean;
 114     FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer;
 115     FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer;
 116     FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean;
 117     FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean;
 118     FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean;
 119     FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean;
 120
 121     -- sequence functions
 122     FUNCTION seq(M IN OUT NOCOPY mal_table,
 123                  type_id integer,
 124                  items mal_vals,
 125                  meta integer DEFAULT 1) RETURN integer;
 126     FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer;
 127     FUNCTION list(M IN OUT NOCOPY mal_table,
 128                   a integer) RETURN integer;
 129     FUNCTION list(M IN OUT NOCOPY mal_table,
 130                   a integer, b integer) RETURN integer;
 131     FUNCTION list(M IN OUT NOCOPY mal_table,
 132                   a integer, b integer, c integer) RETURN integer;
 133
 134     FUNCTION first(M IN OUT NOCOPY mal_table,
 135                    seq integer) RETURN integer;
 136     FUNCTION slice(M IN OUT NOCOPY mal_table,
 137                    seq integer,
 138                    idx integer,
 139                    last integer DEFAULT NULL) RETURN integer;
 140     FUNCTION slice(M IN OUT NOCOPY mal_table,
 141                    items mal_vals,
 142                    idx integer) RETURN integer;
 143     FUNCTION islice(items mal_vals,
 144                     idx integer) RETURN mal_vals;
 145     FUNCTION nth(M IN OUT NOCOPY mal_table,
 146                  seq integer, idx integer) RETURN integer;
 147
 148     FUNCTION count(M IN OUT NOCOPY mal_table,
 149                    seq integer) RETURN integer;
 150
 151     FUNCTION atom_new(M IN OUT NOCOPY mal_table,
 152                       val integer) RETURN integer;
 153     FUNCTION atom_reset(M IN OUT NOCOPY mal_table,
 154                         atm integer,
 155                         val integer) RETURN integer;
 156
 157     -- hash-map functions
 158     FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table,
 159                         H IN OUT NOCOPY map_entry_table,
 160                         midx integer,
 161                         kvs mal_vals) RETURN integer;
 162     FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table,
 163                          H IN OUT NOCOPY map_entry_table,
 164                          midx integer,
 165                          ks mal_vals) RETURN integer;
 166     FUNCTION hash_map(M IN OUT NOCOPY mal_table,
 167                       H IN OUT NOCOPY map_entry_table,
 168                       kvs mal_vals,
 169                       meta integer DEFAULT 1) RETURN integer;
 170
 171     -- function functions
 172     FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer;
 173     FUNCTION malfunc(M IN OUT NOCOPY mal_table,
 174                      ast       integer,
 175                      params    integer,
 176                      env       integer,
 177                      is_macro  integer DEFAULT 0,
 178                      meta      integer DEFAULT 1) RETURN integer;
 179 END types;
 180 /
 181 show errors;
 182
 183
 184 CREATE OR REPLACE PACKAGE BODY types IS
 185
 186 -- ---------------------------------------------------------
 187 -- general functions
 188
 189 FUNCTION mem_new RETURN mal_table IS
 190 BEGIN
 191     -- initialize mal type memory pool
 192     -- 1 -> nil
 193     -- 2 -> false
 194     -- 3 -> true
 195     RETURN mal_table(mal_T(0), mal_T(1), mal_T(2));
 196 END;
 197
 198 FUNCTION tf(val boolean) RETURN integer IS
 199 BEGIN
 200     IF val THEN
 201         RETURN 3; -- true
 202     ELSE
 203         RETURN 2; -- false
 204     END IF;
 205 END;
 206
 207 FUNCTION equal_Q(M IN OUT NOCOPY mal_table,
 208                  H IN OUT NOCOPY map_entry_table,
 209                  a integer, b integer) RETURN boolean IS
 210     atyp   integer;
 211     btyp   integer;
 212     aseq   mal_vals;
 213     bseq   mal_vals;
 214     amidx  integer;
 215     bmidx  integer;
 216     i      integer;
 217     k      varchar2(256);
 218 BEGIN
 219     atyp := M(a).type_id;
 220     btyp := M(b).type_id;
 221     IF NOT (atyp = btyp OR (atyp IN (8,9) AND btyp IN (8,9))) THEN
 222         RETURN FALSE;
 223     END IF;
 224
 225     CASE
 226     WHEN atyp IN (0,1,2) THEN
 227         RETURN TRUE;
 228     WHEN atyp = 3 THEN
 229         RETURN TREAT(M(a) AS mal_int_T).val_int =
 230                TREAT(M(b) AS mal_int_T).val_int;
 231     WHEN atyp IN (5,6,7) THEN
 232         IF TREAT(M(a) AS mal_str_T).val_str IS NULL AND
 233            TREAT(M(b) AS mal_str_T).val_str IS NULL THEN
 234             RETURN TRUE;
 235         ELSE
 236             RETURN TREAT(M(a) AS mal_str_T).val_str =
 237                    TREAT(M(b) AS mal_str_T).val_str;
 238         END IF;
 239     WHEN atyp IN (8,9) THEN
 240         aseq := TREAT(M(a) AS mal_seq_T).val_seq;
 241         bseq := TREAT(M(b) AS mal_seq_T).val_seq;
 242         IF aseq.COUNT <> bseq.COUNT THEN
 243             RETURN FALSE;
 244         END IF;
 245         FOR i IN 1..aseq.COUNT LOOP
 246             IF NOT equal_Q(M, H, aseq(i), bseq(i)) THEN
 247                 RETURN FALSE;
 248             END IF;
 249         END LOOP;
 250         RETURN TRUE;
 251     WHEN atyp = 10 THEN
 252         amidx := TREAT(M(a) AS mal_map_T).map_idx;
 253         bmidx := TREAT(M(b) AS mal_map_T).map_idx;
 254         IF H(amidx).COUNT() <> H(bmidx).COUNT() THEN
 255             RETURN FALSE;
 256         END IF;
 257
 258         k := H(amidx).FIRST();
 259         WHILE k IS NOT NULL LOOP
 260             IF H(amidx)(k) IS NULL OR H(bmidx)(k) IS NULL THEN
 261                 RETURN FALSE;
 262             END IF;
 263             IF NOT equal_Q(M, H, H(amidx)(k), H(bmidx)(k)) THEN
 264                 RETURN FALSE;
 265             END IF;
 266             k := H(amidx).NEXT(k);
 267         END LOOP;
 268         RETURN TRUE;
 269     ELSE
 270         RETURN FALSE;
 271     END CASE;
 272 END;
 273
 274 FUNCTION clone(M IN OUT NOCOPY mal_table,
 275                H IN OUT NOCOPY map_entry_table,
 276                obj integer,
 277                meta integer DEFAULT 1) RETURN integer IS
 278     type_id  integer;
 279     new_hm    integer;
 280     old_midx  integer;
 281     new_midx  integer;
 282     k         varchar2(256);
 283     malfn     mal_func_T;
 284 BEGIN
 285     type_id := M(obj).type_id;
 286     CASE
 287     WHEN type_id IN (8,9) THEN  -- list/vector
 288         RETURN seq(M, type_id,
 289                       TREAT(M(obj) AS mal_seq_T).val_seq,
 290                       meta);
 291     WHEN type_id = 10 THEN      -- hash-map
 292         new_hm := types.hash_map(M, H, mal_vals(), meta);
 293         old_midx := TREAT(M(obj) AS mal_map_T).map_idx;
 294         new_midx := TREAT(M(new_hm) AS mal_map_T).map_idx;
 295
 296         k := H(old_midx).FIRST();
 297         WHILE k IS NOT NULL LOOP
 298             H(new_midx)(k) := H(old_midx)(k);
 299             k := H(old_midx).NEXT(k);
 300         END LOOP;
 301
 302         RETURN new_hm;
 303     WHEN type_id = 12 THEN      -- mal function
 304         malfn := TREAT(M(obj) AS mal_func_T);
 305         RETURN types.malfunc(M,
 306             malfn.ast,
 307             malfn.params,
 308             malfn.env,
 309             malfn.is_macro,
 310             meta);
 311     ELSE
 312         raise_application_error(-20008,
 313             'clone not supported for type ' || type_id, TRUE);
 314     END CASE;
 315 END;
 316
 317
 318 -- ---------------------------------------------------------
 319 -- scalar functions
 320
 321
 322 FUNCTION int(M IN OUT NOCOPY mal_table, num integer) RETURN integer IS
 323 BEGIN
 324     M.EXTEND();
 325     M(M.COUNT()) := mal_int_T(3, num);
 326     RETURN M.COUNT();
 327 END;
 328
 329 FUNCTION string(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS
 330 BEGIN
 331     M.EXTEND();
 332     IF LENGTH(name) <= 4000 THEN
 333         M(M.COUNT()) := mal_str_T(5, name);
 334     ELSE
 335         M(M.COUNT()) := mal_long_str_T(6, NULL, name);
 336     END IF;
 337     RETURN M.COUNT();
 338 END;
 339
 340 FUNCTION string_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS
 341     str  CLOB;
 342 BEGIN
 343     IF M(val).type_id IN (5,6) THEN
 344         IF M(val).type_id = 5 THEN
 345             str := TREAT(M(val) AS mal_str_T).val_str;
 346         ELSE
 347             str := TREAT(M(val) AS mal_long_str_T).val_long_str;
 348         END IF;
 349         IF str IS NULL OR
 350            str = EMPTY_CLOB() OR
 351            SUBSTR(str, 1, 1) <> chr(127) THEN
 352             RETURN TRUE;
 353         ELSE
 354             RETURN FALSE;
 355         END IF;
 356     ELSE
 357         RETURN FALSE;
 358     END IF;
 359 END;
 360
 361 FUNCTION symbol(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS
 362 BEGIN
 363     M.EXTEND();
 364     M(M.COUNT()) := mal_str_T(7, name);
 365     RETURN M.COUNT();
 366 END;
 367
 368 FUNCTION keyword(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS
 369 BEGIN
 370     M.EXTEND();
 371     M(M.COUNT()) := mal_str_T(5, chr(127) || name);
 372     RETURN M.COUNT();
 373 END;
 374
 375 FUNCTION keyword_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS
 376     str  CLOB;
 377 BEGIN
 378     IF M(val).type_id = 5 THEN
 379         str := TREAT(M(val) AS mal_str_T).val_str;
 380         IF LENGTH(str) > 0 AND SUBSTR(str, 1, 1) = chr(127) THEN
 381             RETURN TRUE;
 382         ELSE
 383             RETURN FALSE;
 384         END IF;
 385     ELSE
 386         RETURN FALSE;
 387     END IF;
 388 END;
 389
 390 FUNCTION number_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS
 391     str  CLOB;
 392 BEGIN
 393     IF M(val).type_id IN (3,4) THEN
 394         RETURN TRUE;
 395     ELSE
 396         RETURN FALSE;
 397     END IF;
 398 END;
 399
 400 FUNCTION function_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS
 401     str  CLOB;
 402 BEGIN
 403     IF M(val).type_id = 11 THEN
 404         RETURN TRUE;
 405     ELSIF M(val).type_id = 12 THEN
 406         RETURN TREAT(M(val) AS mal_func_T).is_macro = 0;
 407     ELSE
 408         RETURN FALSE;
 409     END IF;
 410 END;
 411
 412 FUNCTION macro_Q(M IN OUT NOCOPY mal_table, val integer) RETURN boolean IS
 413     str  CLOB;
 414 BEGIN
 415     IF M(val).type_id = 12 THEN
 416         RETURN TREAT(M(val) AS mal_func_T).is_macro > 0;
 417     ELSE
 418         RETURN FALSE;
 419     END IF;
 420 END;
 421
 422
 423 -- ---------------------------------------------------------
 424 -- sequence functions
 425
 426 FUNCTION seq(M IN OUT NOCOPY mal_table,
 427              type_id integer,
 428              items mal_vals,
 429              meta integer DEFAULT 1) RETURN integer IS
 430 BEGIN
 431     M.EXTEND();
 432     M(M.COUNT()) := mal_seq_T(type_id, items, meta);
 433     RETURN M.COUNT();
 434 END;
 435
 436 -- list:
 437 -- return a mal list
 438 FUNCTION list(M IN OUT NOCOPY mal_table) RETURN integer IS
 439 BEGIN
 440     M.EXTEND();
 441     M(M.COUNT()) := mal_seq_T(8, mal_vals(), 1);
 442     RETURN M.COUNT();
 443 END;
 444
 445 FUNCTION list(M IN OUT NOCOPY mal_table,
 446               a integer) RETURN integer IS
 447 BEGIN
 448     M.EXTEND();
 449     M(M.COUNT()) := mal_seq_T(8, mal_vals(a), 1);
 450     RETURN M.COUNT();
 451 END;
 452
 453 FUNCTION list(M IN OUT NOCOPY mal_table,
 454               a integer, b integer) RETURN integer IS
 455 BEGIN
 456     M.EXTEND();
 457     M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b), 1);
 458     RETURN M.COUNT();
 459 END;
 460
 461 FUNCTION list(M IN OUT NOCOPY mal_table,
 462               a integer, b integer, c integer) RETURN integer IS
 463 BEGIN
 464     M.EXTEND();
 465     M(M.COUNT()) := mal_seq_T(8, mal_vals(a, b, c), 1);
 466     RETURN M.COUNT();
 467 END;
 468
 469 FUNCTION first(M IN OUT NOCOPY mal_table,
 470                seq integer) RETURN integer IS
 471 BEGIN
 472     RETURN TREAT(M(seq) AS mal_seq_T).val_seq(1);
 473 END;
 474
 475 FUNCTION slice(M IN OUT NOCOPY mal_table,
 476                seq integer,
 477                idx integer,
 478                last integer DEFAULT NULL) RETURN integer IS
 479     old_items  mal_vals;
 480     new_items  mal_vals;
 481     i          integer;
 482     final_idx  integer;
 483 BEGIN
 484     old_items := TREAT(M(seq) AS mal_seq_T).val_seq;
 485     new_items := mal_vals();
 486     IF last IS NULL THEN
 487         final_idx := old_items.COUNT();
 488     ELSE
 489         final_idx := last + 1;
 490     END IF;
 491     IF final_idx > idx THEN
 492         new_items.EXTEND(final_idx - idx);
 493         FOR i IN idx+1..final_idx LOOP
 494             new_items(i-idx) := old_items(i);
 495         END LOOP;
 496     END IF;
 497     M.EXTEND();
 498     M(M.COUNT()) := mal_seq_T(8, new_items, 1);
 499     RETURN M.COUNT();
 500 END;
 501
 502 FUNCTION slice(M IN OUT NOCOPY mal_table,
 503                items mal_vals,
 504                idx integer) RETURN integer IS
 505     new_items  mal_vals;
 506 BEGIN
 507     new_items := islice(items, idx);
 508     M.EXTEND();
 509     M(M.COUNT()) := mal_seq_T(8, new_items, 1);
 510     RETURN M.COUNT();
 511 END;
 512
 513 FUNCTION islice(items mal_vals,
 514                 idx integer) RETURN mal_vals IS
 515     new_items  mal_vals;
 516     i          integer;
 517 BEGIN
 518     new_items := mal_vals();
 519     IF items.COUNT > idx THEN
 520         new_items.EXTEND(items.COUNT - idx);
 521         FOR i IN idx+1..items.COUNT LOOP
 522             new_items(i-idx) := items(i);
 523         END LOOP;
 524     END IF;
 525     RETURN new_items;
 526 END;
 527
 528
 529 FUNCTION nth(M IN OUT NOCOPY mal_table,
 530              seq integer, idx integer) RETURN integer IS
 531 BEGIN
 532     RETURN TREAT(M(seq) AS mal_seq_T).val_seq(idx+1);
 533 END;
 534
 535 FUNCTION count(M IN OUT NOCOPY mal_table,
 536                seq integer) RETURN integer IS
 537 BEGIN
 538     RETURN TREAT(M(seq) AS mal_seq_T).val_seq.COUNT;
 539 END;
 540
 541 -- ---------------------------------------------------------
 542 -- hash-map functions
 543
 544 FUNCTION assoc_BANG(M IN OUT NOCOPY mal_table,
 545                     H IN OUT NOCOPY map_entry_table,
 546                     midx integer,
 547                     kvs mal_vals) RETURN integer IS
 548     i     integer;
 549 BEGIN
 550     IF MOD(kvs.COUNT(), 2) = 1 THEN
 551         raise_application_error(-20007,
 552             'odd number of arguments to assoc', TRUE);
 553     END IF;
 554
 555     i := 1;
 556     WHILE i <= kvs.COUNT() LOOP
 557         H(midx)(TREAT(M(kvs(i)) AS mal_str_T).val_str) := kvs(i+1);
 558         i := i + 2;
 559     END LOOP;
 560     RETURN midx;
 561 END;
 562
 563 FUNCTION dissoc_BANG(M IN OUT NOCOPY mal_table,
 564                      H IN OUT NOCOPY map_entry_table,
 565                      midx integer,
 566                      ks mal_vals) RETURN integer IS
 567     i     integer;
 568 BEGIN
 569     FOR i IN 1..ks.COUNT() LOOP
 570         H(midx).DELETE(TREAT(M(ks(i)) AS mal_str_T).val_str);
 571     END LOOP;
 572     RETURN midx;
 573 END;
 574
 575 FUNCTION hash_map(M IN OUT NOCOPY mal_table,
 576                   H IN OUT NOCOPY map_entry_table,
 577                   kvs mal_vals,
 578                   meta integer DEFAULT 1) RETURN integer IS
 579     midx  integer;
 580 BEGIN
 581     H.EXTEND();
 582     midx := H.COUNT();
 583     midx := assoc_BANG(M, H, midx, kvs);
 584
 585     M.EXTEND();
 586     M(M.COUNT()) := mal_map_T(10, midx, meta);
 587     RETURN M.COUNT();
 588 END;
 589
 590
 591 -- ---------------------------------------------------------
 592 -- function functions
 593
 594 FUNCTION func(M IN OUT NOCOPY mal_table, name varchar) RETURN integer IS
 595 BEGIN
 596     M.EXTEND();
 597     M(M.COUNT()) := mal_str_T(11, name);
 598     RETURN M.COUNT();
 599 END;
 600
 601 FUNCTION malfunc(M IN OUT NOCOPY mal_table,
 602                  ast       integer,
 603                  params    integer,
 604                  env       integer,
 605                  is_macro  integer DEFAULT 0,
 606                  meta      integer DEFAULT 1) RETURN integer IS
 607 BEGIN
 608     M.EXTEND();
 609     M(M.COUNT()) := mal_func_T(12, ast, params, env, is_macro, meta);
 610     RETURN M.COUNT();
 611 END;
 612
 613
 614 -- ---------------------------------------------------------
 615 -- atom functions
 616
 617 FUNCTION atom_new(M IN OUT NOCOPY mal_table,
 618                   val integer) RETURN integer IS
 619     aidx  integer;
 620 BEGIN
 621     M.EXTEND();
 622     M(M.COUNT()) := mal_atom_T(13, val);
 623     RETURN M.COUNT();
 624 END;
 625
 626 FUNCTION atom_reset(M IN OUT NOCOPY mal_table,
 627                     atm integer,
 628                     val integer) RETURN integer IS
 629 BEGIN
 630     M(atm) := mal_atom_T(13, val);
 631     RETURN val;
 632 END;
 633
 634
 635
 636 END types;
 637 /
 638 show errors;