Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/sql/sqldml.src

Text File | 1988-05-03 | 121.1 KB | 3,720 lines

--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--txtprt.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
  use TEXT_IO;

package TEXT_PRINT is

  type LINE_TYPE is limited private;

  type BREAK_TYPE is (BREAK, NO_BREAK);

  procedure CREATE_LINE(LINE : in out LINE_TYPE; LENGTH : in POSITIVE);

  procedure SET_LINE(LINE : in LINE_TYPE);

  function CURRENT_LINE return LINE_TYPE;

  procedure SET_INDENT(LINE   : in LINE_TYPE; INDENT : in NATURAL);
  procedure SET_INDENT(INDENT : in NATURAL);

  procedure SET_CONTINUATION_INDENT(LINE   : in LINE_TYPE;
                                    INDENT : in INTEGER);
  procedure SET_CONTINUATION_INDENT(INDENT : in INTEGER);

  procedure PRINT(FILE : in FILE_TYPE;
                  LINE : in LINE_TYPE;
                  ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK);
  procedure PRINT(FILE : in FILE_TYPE;
                  ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK);
  procedure PRINT(LINE : in LINE_TYPE;
                  ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK);
  procedure PRINT(ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK);

  procedure PRINT_LINE(FILE : in FILE_TYPE; LINE : in LINE_TYPE);
  procedure PRINT_LINE(FILE : in FILE_TYPE);
  procedure PRINT_LINE(LINE : in LINE_TYPE);
  procedure PRINT_LINE;

  procedure BLANK_LINE(FILE : in FILE_TYPE; LINE : in LINE_TYPE);
  procedure BLANK_LINE(FILE : in FILE_TYPE);
  procedure BLANK_LINE(LINE : in LINE_TYPE);
  procedure BLANK_LINE;

  generic
    type NUM is range <>;
  package INTEGER_PRINT is

    procedure PRINT(FILE : in FILE_TYPE;
                    LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(FILE : in FILE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);

    procedure PRINT(TO : out STRING; LAST : out NATURAL; ITEM : in NUM);

  end INTEGER_PRINT;

  generic
    type NUM is digits <>;
  package FLOAT_PRINT is

    procedure PRINT(FILE : in FILE_TYPE;
                    LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(FILE : in FILE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);
    procedure PRINT(ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK);

    procedure PRINT(TO : out STRING; LAST : out NATURAL; ITEM : in NUM);

  end FLOAT_PRINT;

  LAYOUT_ERROR : exception renames TEXT_IO.LAYOUT_ERROR;

private

  type LINE_REC(LENGTH : INTEGER) is
    record
      USED_YET            : BOOLEAN := FALSE;
      INDENT              : INTEGER := 0;
      CONTINUATION_INDENT : INTEGER := 2;
      BREAK               : INTEGER := 1;
      INDEX               : INTEGER := 1;
      DATA                : STRING(1..LENGTH);
    end record;

  type LINE_TYPE is access LINE_REC;

end TEXT_PRINT;

package body TEXT_PRINT is

  DEFAULT_LINE : LINE_TYPE;

  procedure CREATE_LINE(LINE : in out LINE_TYPE; LENGTH : in POSITIVE) is
  begin
    LINE := new LINE_REC(LENGTH);
  end CREATE_LINE;

  procedure SET_LINE(LINE : in LINE_TYPE) is
  begin
    DEFAULT_LINE := LINE;
  end SET_LINE;

  function CURRENT_LINE return LINE_TYPE is
  begin
    return DEFAULT_LINE;
  end CURRENT_LINE;

  procedure SET_INDENT(LINE   : in LINE_TYPE; INDENT : in NATURAL) is
  begin
    if INDENT >= LINE.LENGTH then
      raise LAYOUT_ERROR;
    end if;
    if LINE.INDEX = LINE.INDENT + 1 then
      for I in 1..INDENT loop
        LINE.DATA(I) := ' ';
      end loop;
    end if;
    LINE.INDENT := INDENT;
  end SET_INDENT;

  procedure SET_INDENT(INDENT : in NATURAL) is
  begin
    SET_INDENT(DEFAULT_LINE,INDENT);
  end SET_INDENT;

  procedure SET_CONTINUATION_INDENT(LINE   : in LINE_TYPE;
                                    INDENT : in INTEGER) is
  begin
    if LINE.INDENT + INDENT >= LINE.LENGTH or else LINE.INDENT + INDENT < 0
        then
      raise LAYOUT_ERROR;
    end if;
    LINE.CONTINUATION_INDENT := INDENT;
  end SET_CONTINUATION_INDENT;

  procedure SET_CONTINUATION_INDENT(INDENT : in INTEGER) is
  begin
    SET_CONTINUATION_INDENT(DEFAULT_LINE,INDENT);
  end SET_CONTINUATION_INDENT;

  procedure PRINT(FILE : in FILE_TYPE;
                  LINE : in LINE_TYPE;
                  ITEM : in STRING;
                  BRK  : BREAK_TYPE := BREAK) is
    NEW_BREAK, NEW_INDEX : INTEGER;
  begin
    if LINE.INDEX + ITEM'LENGTH > LINE.LENGTH + 1 then
      if LINE.INDENT + LINE.CONTINUATION_INDENT + LINE.INDEX - LINE.BREAK +
          ITEM'LENGTH > LINE.LENGTH then
        raise LAYOUT_ERROR;
      end if;
      if ITEM = " " then
        return;
      end if;
      PUT_LINE(FILE,LINE.DATA(1..LINE.BREAK-1));
      for I in 1..LINE.INDENT + LINE.CONTINUATION_INDENT loop
        LINE.DATA(I) := ' ';
      end loop;
      NEW_BREAK := LINE.INDENT + LINE.CONTINUATION_INDENT + 1;
      NEW_INDEX := NEW_BREAK + LINE.INDEX - LINE.BREAK;
      LINE.DATA(NEW_BREAK..NEW_INDEX) := LINE.DATA(LINE.BREAK..LINE.INDEX);
      LINE.BREAK := NEW_BREAK;
      LINE.INDEX := NEW_INDEX;
    end if;
    NEW_INDEX := LINE.INDEX + ITEM'LENGTH;
    LINE.DATA(LINE.INDEX..NEW_INDEX-1) := ITEM;
    LINE.INDEX := NEW_INDEX;
    if BRK = BREAK then
      LINE.BREAK := NEW_INDEX;
    end if;
    LINE.USED_YET := TRUE;
  end PRINT;

  procedure PRINT(FILE : in FILE_TYPE;
                  ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK) is
  begin
    PRINT(FILE,DEFAULT_LINE,ITEM,BRK);
  end PRINT;

  procedure PRINT(LINE : in LINE_TYPE;
                  ITEM : in STRING;
                  BRK  : in BREAK_TYPE := BREAK) is
  begin
    PRINT(CURRENT_OUTPUT,LINE,ITEM,BRK);
  end PRINT;

  procedure PRINT(ITEM : in STRING; BRK : in BREAK_TYPE := BREAK) is
  begin
    PRINT(CURRENT_OUTPUT,DEFAULT_LINE,ITEM,BRK);
  end PRINT;

  procedure PRINT_LINE(FILE : in FILE_TYPE; LINE : in LINE_TYPE) is
  begin
    if LINE.INDEX /= LINE.INDENT + 1 then
      PUT_LINE(FILE,LINE.DATA(1..LINE.INDEX-1));
    end if;
    for I in 1..LINE.INDENT loop
      LINE.DATA(I) := ' ';
    end loop;
    LINE.INDEX := LINE.INDENT + 1;
    LINE.BREAK := LINE.INDEX;
  end PRINT_LINE;

  procedure PRINT_LINE(FILE : in FILE_TYPE) is
  begin
    PRINT_LINE(FILE,DEFAULT_LINE);
  end PRINT_LINE;

  procedure PRINT_LINE(LINE : in LINE_TYPE) is
  begin
    PRINT_LINE(CURRENT_OUTPUT,LINE);
  end PRINT_LINE;

  procedure PRINT_LINE is
  begin
    PRINT_LINE(CURRENT_OUTPUT,DEFAULT_LINE);
  end PRINT_LINE;

  procedure BLANK_LINE(FILE : in FILE_TYPE; LINE : in LINE_TYPE) is
  begin
    if LINE.USED_YET then
      NEW_LINE(FILE);
    end if;
  end BLANK_LINE;

  procedure BLANK_LINE(FILE : in FILE_TYPE) is
  begin
    BLANK_LINE(FILE,DEFAULT_LINE);
  end BLANK_LINE;

  procedure BLANK_LINE(LINE : in LINE_TYPE) is
  begin
    BLANK_LINE(CURRENT_OUTPUT,LINE);
  end BLANK_LINE;

  procedure BLANK_LINE is
  begin
    BLANK_LINE(CURRENT_OUTPUT,DEFAULT_LINE);
  end BLANK_LINE;

  package body INTEGER_PRINT is

    procedure PRINT(FILE : in FILE_TYPE;
                    LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
      S : STRING(1..NUM'WIDTH);
      L : NATURAL;
    begin
      PRINT(S,L,ITEM);
      PRINT(FILE,LINE,S(1..L),BRK);
    end PRINT;

    procedure PRINT(FILE : in FILE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(FILE,DEFAULT_LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(CURRENT_OUTPUT,LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(CURRENT_OUTPUT,DEFAULT_LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(TO : out STRING; LAST : out NATURAL; ITEM : in NUM) is
      S : constant STRING := NUM'IMAGE(ITEM);
      F : NATURAL := S'FIRST; -- Bug in DG Compiler -- S'FIRST /= 1 ! ! ! ! ! !
      L : NATURAL;
    begin
      if S(F) = ' ' then
        F := F + 1;
      end if;
      if TO'LENGTH < S'LAST - F + 1 then
        raise LAYOUT_ERROR;
      end if;
      L := TO'FIRST + S'LAST - F;
      TO(TO'FIRST..L) := S(F..S'LAST);
      LAST := L;
    end PRINT;

  end INTEGER_PRINT;

  package body FLOAT_PRINT is

    package NUM_IO is new FLOAT_IO(NUM);
      use NUM_IO;

    procedure PRINT(FILE : in FILE_TYPE;
                    LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
      S : STRING(1..DEFAULT_FORE + DEFAULT_AFT + DEFAULT_EXP + 2);
      L : NATURAL;
    begin
      PRINT(S,L,ITEM);
      PRINT(FILE,LINE,S(1..L),BRK);
    end PRINT;

    procedure PRINT(FILE : in FILE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(FILE,DEFAULT_LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(LINE : in LINE_TYPE;
                    ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(CURRENT_OUTPUT,LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(ITEM : in NUM;
                    BRK  : in BREAK_TYPE := BREAK) is
    begin
      PRINT(CURRENT_OUTPUT,DEFAULT_LINE,ITEM,BRK);
    end PRINT;

    procedure PRINT(TO : out STRING; LAST : out NATURAL; ITEM : in NUM) is
      S         : STRING(1..DEFAULT_FORE + DEFAULT_AFT + DEFAULT_EXP + 2);
      EXP       : INTEGER;
      E_INDEX   : NATURAL := S'LAST - DEFAULT_EXP;
      DOT_INDEX : NATURAL := DEFAULT_FORE + 1;
      L         : NATURAL := 0;
    begin
      PUT(S,ITEM);
      EXP := INTEGER'VALUE(S(E_INDEX+1..S'LAST));
      if EXP >= 0 and then EXP <= DEFAULT_AFT-1 then
        S(DOT_INDEX..DOT_INDEX+EXP-1) := S(DOT_INDEX+1..DOT_INDEX+EXP);
        S(DOT_INDEX+EXP) := '.';
        for I in E_INDEX..S'LAST loop
          S(I) := ' ';
        end loop;
      end if;
      for I in reverse 1..E_INDEX-1 loop
        exit when S(I) /= '0' or else S(I-1) = '.';
        S(I) := ' ';
      end loop;
      for I in S'RANGE loop
        if S(I) /= ' ' then
          L := L + 1;
          TO(L) := S(I);
        end if;
      end loop;
      LAST := L;
    exception
      when CONSTRAINT_ERROR =>
        raise LAYOUT_ERROR;
    end PRINT;

  end FLOAT_PRINT;

end TEXT_PRINT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--txtinp.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_IO;
  use TEXT_IO;

package TEXT_INPUT is

  type STRING_LINK is access STRING;

  type BUFFER_TYPE is private;

  package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
  package FLOAT_IO   is new TEXT_IO.FLOAT_IO(FLOAT);
    use INTEGER_IO, FLOAT_IO;

  function MAKE_BUFFER(LENGTH : POSITIVE) return BUFFER_TYPE;

  procedure OPEN_INPUT(BUFFER : in out BUFFER_TYPE;
                       MODE   : in FILE_MODE;
                       NAME   : in STRING);

  procedure CLOSE_INPUT(BUFFER : in out BUFFER_TYPE);

  function END_OF_FILE(BUFFER : BUFFER_TYPE) return BOOLEAN;

  procedure CARD_ERROR(BUFFER : in BUFFER_TYPE; MESSAGE : in STRING);

  procedure IN_IDENT(BUFFER : in out BUFFER_TYPE; -- calls NEXT_TOKEN!
                     IDENT  : out    STRING;      -- leaves ptr after ident
                     LAST   : out    NATURAL);

  function IN_INTEGER(BUFFER : BUFFER_TYPE) return INTEGER;
  function IN_FLOAT  (BUFFER : BUFFER_TYPE) return FLOAT;
  function IN_STRING (BUFFER : BUFFER_TYPE) return STRING_LINK;

private

  type BUFFER_REC(LENGTH : POSITIVE) is
    record
      BUFFER : STRING(1..LENGTH);
      FILE   : FILE_TYPE;
      NEXT   : POSITIVE := 1;
      LAST   : NATURAL  := 0;
    end record;

  type BUFFER_TYPE is access BUFFER_REC;

end TEXT_INPUT;

with TEXT_IO;
  use TEXT_IO;

package body TEXT_INPUT is

  function MAKE_BUFFER(LENGTH : POSITIVE) return BUFFER_TYPE is
  begin
    return new BUFFER_REC(LENGTH);
  end MAKE_BUFFER;

  procedure OPEN_INPUT(BUFFER : in out BUFFER_TYPE;
                       MODE   : in FILE_MODE;
                       NAME   : in STRING) is
  begin
    OPEN(BUFFER.FILE,MODE,NAME);
  end OPEN_INPUT;

  procedure CLOSE_INPUT(BUFFER : in out BUFFER_TYPE) is
  begin
    CLOSE(BUFFER.FILE);
  end CLOSE_INPUT;

  function END_OF_FILE(BUFFER : BUFFER_TYPE) return BOOLEAN is
  begin
    return END_OF_FILE(BUFFER.FILE);
  end END_OF_FILE;

  procedure CARD_ERROR(BUFFER : in BUFFER_TYPE; MESSAGE : in STRING) is
  begin
    PUT_LINE("***** Error on input card:");
    PUT_LINE(BUFFER.BUFFER(1..BUFFER.LAST));
    PUT_LINE(MESSAGE);
    raise DATA_ERROR;
  end CARD_ERROR;

  procedure NEXT_LINE(BUFFER : in BUFFER_TYPE) is
  begin
    loop
      GET_LINE(BUFFER.FILE,BUFFER.BUFFER,BUFFER.LAST);
      exit when BUFFER.LAST >= 2 and then BUFFER.BUFFER(1..2) /= "--";
      exit when BUFFER.LAST = 1;
    end loop;
    BUFFER.NEXT := 1;
  end NEXT_LINE;

  procedure NEXT_TOKEN(BUFFER : in BUFFER_TYPE) is
  begin
    loop
      if BUFFER.NEXT > BUFFER.LAST then
        NEXT_LINE(BUFFER);
      end if;
      if BUFFER.BUFFER(BUFFER.NEXT) = '-' and then
          BUFFER.NEXT < BUFFER.LAST and then
          BUFFER.BUFFER(BUFFER.NEXT+1) = '-' then
        NEXT_LINE(BUFFER);
      end if;
      exit when BUFFER.BUFFER(BUFFER.NEXT) /= ' ' and then
          BUFFER.BUFFER(BUFFER.NEXT) /= ASCII.HT;
      BUFFER.NEXT := BUFFER.NEXT + 1;
    end loop;
  end NEXT_TOKEN;

  function TOKEN_END(BUFFER : BUFFER_TYPE) return POSITIVE is
    PTR : POSITIVE;
  begin
    NEXT_TOKEN(BUFFER);
    PTR := BUFFER.NEXT;
    while PTR <= BUFFER.LAST and then BUFFER.BUFFER(PTR) /= ' ' and then
        BUFFER.BUFFER(PTR) /= ASCII.HT loop
      PTR := PTR + 1;
    end loop;
    return PTR-1;
  end TOKEN_END;

  procedure IN_IDENT(BUFFER : in out BUFFER_TYPE;
                     IDENT  : out    STRING;
                     LAST   : out    NATURAL) is
    TOKEND,
    TLAST : POSITIVE;
  begin
    TOKEND := TOKEN_END(BUFFER);
    TLAST := IDENT'FIRST + TOKEND - BUFFER.NEXT;
    IDENT(IDENT'FIRST..TLAST) := BUFFER.BUFFER(BUFFER.NEXT..TOKEND);
    LAST := TLAST;
    BUFFER.NEXT := TOKEND + 1;
  end IN_IDENT;

  function IN_INTEGER(BUFFER : BUFFER_TYPE) return INTEGER is
    TOKEND : POSITIVE;
    INT,
    LAST   : INTEGER;
  begin
    TOKEND := TOKEN_END(BUFFER);
    GET(BUFFER.BUFFER(BUFFER.NEXT..TOKEND),INT,LAST);
    BUFFER.NEXT := TOKEND + 1;
    return INT;
  end IN_INTEGER;

  function IN_FLOAT  (BUFFER : BUFFER_TYPE) return FLOAT is
    TOKEND : POSITIVE;
    FLT    : FLOAT;
    LAST   : INTEGER;
  begin
    TOKEND := TOKEN_END(BUFFER);
    GET(BUFFER.BUFFER(BUFFER.NEXT..TOKEND),FLT,LAST);
    BUFFER.NEXT := TOKEND + 1;
    return FLT;
  end IN_FLOAT;

  function IN_STRING (BUFFER : BUFFER_TYPE) return STRING_LINK is
    PTR : POSITIVE;
    STR : STRING_LINK;
  begin
    NEXT_TOKEN(BUFFER);
    if BUFFER.BUFFER(BUFFER.NEXT) /= '"' then
      raise DATA_ERROR;
    end if;
    PTR := BUFFER.NEXT + 1;
    while PTR <= BUFFER.LAST and then BUFFER.BUFFER(PTR) /= '"' loop
      PTR := PTR + 1;
    end loop;
    if PTR > BUFFER.LAST then
      raise DATA_ERROR;
    end if;
    STR := new STRING(1..PTR-BUFFER.NEXT-1);
    STR.all := BUFFER.BUFFER(BUFFER.NEXT+1..PTR-1);
    BUFFER.NEXT := PTR + 1;
    return STR;
  end IN_STRING;

end TEXT_INPUT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sqldef.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_INPUT;
  use TEXT_INPUT;

package SQL_DEFINITIONS is

  type TABLE is private;
  type FIELD is private;

  type TABLE_NAME is private;
  type FIELD_NAME is private;

  subtype STRING_LINK is TEXT_INPUT.STRING_LINK;

  type OPERATOR_TYPE is (O_SELECT, O_INSERT, O_DELETE, O_UPDATE, O_LIKE,
      O_SUM, O_AVG, O_MAX, O_MIN, O_COUNT, O_IN, O_EXISTS, O_DESC, O_AND,
      O_OR, O_XOR, O_EQ, O_NE, O_LT, O_LE, O_GT, O_GE, O_PLUS, O_MINUS, O_CAT,
      O_UNARY_PLUS, O_UNARY_MINUS, O_TIMES, O_DIV, O_MOD, O_REM, O_POWER,
      O_ABS, O_NOT);

  STAR,
  NULL_FIELD : constant FIELD;
  NULL_TABLE : constant TABLE;

  function MAKE_TABLE_NAME(NAME : STRING) return TABLE_NAME;

  function MAKE_FIELD(RELATION : TABLE_NAME; TEMPLATE : FIELD) return FIELD;

  function MAKE_FIELD(NAME : STRING) return FIELD;

  function TABLEIFY(F : FIELD) return TABLE;

  function FIELDIFY(F : FIELD)     return FIELD;
  function FIELDIFY(F : INTEGER)   return FIELD;
  function FIELDIFY(F : FLOAT)     return FIELD;
  function FIELDIFY(F : STRING)    return FIELD;

  function L_FIELDIFY(F : FIELD)     return FIELD renames FIELDIFY;
  function L_FIELDIFY(F : INTEGER)   return FIELD renames FIELDIFY;
  function L_FIELDIFY(F : FLOAT)     return FIELD renames FIELDIFY;
  function L_FIELDIFY(F : STRING)    return FIELD renames FIELDIFY;

  function R_FIELDIFY(F : FIELD)     return FIELD renames FIELDIFY;
  function R_FIELDIFY(F : INTEGER)   return FIELD renames FIELDIFY;
  function R_FIELDIFY(F : FLOAT)     return FIELD renames FIELDIFY;
  function R_FIELDIFY(F : STRING)    return FIELD renames FIELDIFY;

  generic
    TABLE_FIELD : FIELD;
  function GET_TABLE return TABLE;

  generic
    FIELD_NAME : FIELD;
  function GET_FIELD_NAME return FIELD;

  generic
    type TABLE_TYPE is private;
    DATA : TABLE_TYPE;
  function GET_FIELDS return TABLE_TYPE;

  generic
    TABLE_FIELD : FIELD;
  function INSERT_FIELDS(F : in FIELD) return FIELD;

  generic
    type VALUE_TYPE is private;
    with function FIELDIFY(F : VALUE_TYPE) return FIELD is <>;
  function VALUES_GEN(V : VALUE_TYPE) return FIELD;

  generic
    OPCODE : OPERATOR_TYPE;
    type L_TYPE is private;
    with function L_FIELDIFY(F : L_TYPE) return FIELD is <>;
  function UNARY_OPERATOR(L : L_TYPE) return FIELD;

  generic
    OPCODE : OPERATOR_TYPE;
    type L_TYPE is private;
    type R_TYPE is private;
    with function L_FIELDIFY(F : L_TYPE) return FIELD is <>;
    with function R_FIELDIFY(F : R_TYPE) return FIELD is <>;
  function BINARY_OPERATOR(L : L_TYPE; R : R_TYPE) return FIELD;

  function SELEC(WHAT   : FIELD := NULL_FIELD;
                 FROM   : TABLE := NULL_TABLE;
                 WHERE  : FIELD := NULL_FIELD;
                 GROUP  : FIELD := NULL_FIELD;
                 HAVING : FIELD := NULL_FIELD;
                 ORDER  : FIELD := NULL_FIELD) return FIELD;

  function INSERT_INTO(WHAT   : FIELD;
                       VALUES : FIELD) return FIELD;

  function INSERT_INTO(WHAT   : TABLE;
                       VALUES : FIELD) return FIELD;

  function INSERT_UNTO(WHAT   : FIELD;
                       VALUES : FIELD) return FIELD renames INSERT_INTO;

  function INSERT_UNTO(WHAT   : TABLE;
                       VALUES : FIELD) return FIELD renames INSERT_INTO;

  generic
    type WHAT_TYPE is private;
    type VALUE_TYPE is private;
    with function INSERT_UNTO(WHAT : WHAT_TYPE; VALUES: FIELD) return FIELD
        is <>;
    with function FIELDIFY(VALUE : VALUE_TYPE) return FIELD is <>;
  function INSERT_GEN(WHAT : WHAT_TYPE; VALUES : VALUE_TYPE) return FIELD;

  function DELETE(FROM  : TABLE := NULL_TABLE;
                  WHERE : FIELD := NULL_FIELD) return FIELD;

  function UPDATE(WHAT  : TABLE := NULL_TABLE;
                  SET   : FIELD;
                  WHERE : FIELD := NULL_FIELD) return FIELD;

  function "&"(L : TABLE; R : TABLE) return TABLE;

  package SQL_FUNCTIONS is

    type DATABASE_TYPE is private;
    type VALUE_LINK    is private;
    type RECORD_LINK   is private;

    type EXTENDED_FIELD_INDEX is new NATURAL;
    subtype FIELD_INDEX is EXTENDED_FIELD_INDEX
        range 1..EXTENDED_FIELD_INDEX'LAST;

    type EXTENDED_TABLE_INDEX is new NATURAL;
    subtype TABLE_INDEX is EXTENDED_TABLE_INDEX
        range 1..EXTENDED_TABLE_INDEX'LAST;

    package PROGRAM_FUNCTIONS is

      type CURSOR_TYPE is private;

      function  EXECUTE     (F : in FIELD) return CURSOR_TYPE;
      procedure EXECUTE     (F : in FIELD);
      procedure LIST        (F : in FIELD);
      procedure SET_DATABASE(DB : in DATABASE_TYPE);
      procedure NEXT_RECORD (CURSOR : in out CURSOR_TYPE);

      procedure FETCH(CURSOR : in  CURSOR_TYPE;
                      FIELD  : in  FIELD_INDEX;
                      INT    : out INTEGER);

      procedure FETCH(CURSOR : in  CURSOR_TYPE;
                      FIELD  : in  FIELD_INDEX;
                      FLT    : out FLOAT);

      procedure FETCH(CURSOR : in  CURSOR_TYPE;
                      FIELD  : in  FIELD_INDEX;
                      STR    : out STRING;
                      LAST   : out NATURAL);

      function FETCH(CURSOR : CURSOR_TYPE;
                     FIELD  : FIELD_INDEX) return INTEGER;

      function FETCH(CURSOR : CURSOR_TYPE;
                     FIELD  : FIELD_INDEX) return FLOAT;

      function FETCH(CURSOR : CURSOR_TYPE;
                     FIELD  : FIELD_INDEX) return STRING;

      CALL_ERROR          : exception;
      DONE_ERROR          : exception;
      FIELD_ERROR         : exception;
      SYNTAX_ERROR        : exception;
      TABLE_ERROR         : exception;
      TRUNCATE_ERROR      : exception;
      TYPE_ERROR          : exception;
      UNIMPLEMENTED_ERROR : exception;

    private

      type QUERY_NODE_REC;

      type QUERY_NODE is access QUERY_NODE_REC;

      type QUERY_NODE_REC is
        record
          NEXT_NODE : QUERY_NODE;
          FIELD     : FIELD_INDEX;
          VALUE     : VALUE_LINK;
        end record;

      type CURSOR_TYPE is
        record
          QUERY          : QUERY_NODE;
          CURRENT_RECORD : RECORD_LINK;
          NEW_QUERY      : BOOLEAN := TRUE;
        end record;

    end PROGRAM_FUNCTIONS;

    package SHOW_PACKAGE is
      procedure SHOW (F : in FIELD);
    end SHOW_PACKAGE;

    package BULK_FUNCTIONS is
      function  LOAD_DATABASE(FILE_NAME : in STRING) return DATABASE_TYPE;
      procedure SAVE_DATABASE(FILE_NAME : in STRING;
                              DATABASE  : in DATABASE_TYPE);
    end BULK_FUNCTIONS;

    subtype CURSOR_TYPE is PROGRAM_FUNCTIONS.CURSOR_TYPE;

    function EXECUTE(F : FIELD) return CURSOR_TYPE
        renames PROGRAM_FUNCTIONS.EXECUTE;

    procedure EXECUTE(F : in FIELD) renames PROGRAM_FUNCTIONS.EXECUTE;
    procedure LIST   (F : in FIELD) renames PROGRAM_FUNCTIONS.LIST;
    procedure SHOW   (F : in FIELD) renames SHOW_PACKAGE.SHOW;

    procedure SET_DATABASE(DB : in DATABASE_TYPE)
        renames PROGRAM_FUNCTIONS.SET_DATABASE;

    procedure NEXT_RECORD(CURSOR : in out CURSOR_TYPE)
        renames PROGRAM_FUNCTIONS.NEXT_RECORD;

    procedure FETCH(CURSOR : in  CURSOR_TYPE;
                    FIELD  : in  FIELD_INDEX;
                    INT    : out INTEGER) renames PROGRAM_FUNCTIONS.FETCH;

    procedure FETCH(CURSOR : in  CURSOR_TYPE;
                    FIELD  : in  FIELD_INDEX;
                    FLT    : out FLOAT) renames PROGRAM_FUNCTIONS.FETCH;

    procedure FETCH(CURSOR : in  CURSOR_TYPE;
                    FIELD  : in  FIELD_INDEX;
                    STR    : out STRING;
                    LAST   : out NATURAL) renames PROGRAM_FUNCTIONS.FETCH;

    function FETCH(CURSOR : CURSOR_TYPE;
mes PROGRAM_FUNCTIONS.FETCH;

    function FETCH(CURSOR : CURSOR_TYPE;
                   FIELD  : FIELD_INDEX) return FLOAT
        renames PROGRAM_FUNCTIONS.FETCH;

    function FETCH(CURSOR : CURSOR_TYPE;
                   FIELD  : FIELD_INDEX) return STRING
        renames PROGRAM_FUNCTIONS.FETCH;

    function LOAD_DATABASE(FILE_NAME : in STRING) return DATABASE_TYPE renames
      BULK_FUNCTIONS.LOAD_DATABASE;

    procedure SAVE_DATABASE(FILE_NAME : in STRING;
                            DATABASE  : in DATABASE_TYPE) renames
      BULK_FUNCTIONS.SAVE_DATABASE;

    CALL_ERROR          : exception renames PROGRAM_FUNCTIONS.CALL_ERROR;
    DONE_ERROR          : exception renames PROGRAM_FUNCTIONS.DONE_ERROR;
    FIELD_ERROR         : exception renames PROGRAM_FUNCTIONS.FIELD_ERROR;
    SYNTAX_ERROR        : exception renames PROGRAM_FUNCTIONS.SYNTAX_ERROR;
    TABLE_ERROR         : exception renames PROGRAM_FUNCTIONS.TABLE_ERROR;
    TRUNCATE_ERROR      : exception renames PROGRAM_FUNCTIONS.TRUNCATE_ERROR;
    TYPE_ERROR          : exception renames PROGRAM_FUNCTIONS.TYPE_ERROR;
    UNIMPLEMENTED_ERROR : exception renames
        PROGRAM_FUNCTIONS.UNIMPLEMENTED_ERROR;

  private

    type DATABASE_FIELD_TYPE is (INTEGER_FIELD, FLOAT_FIELD, STRING_FIELD);

    type VALUE_TYPE(FIELD_TYPE : DATABASE_FIELD_TYPE) is
      record
        case FIELD_TYPE is
          when INTEGER_FIELD =>
            INTEGER_VALUE : INTEGER;
          when FLOAT_FIELD =>
            FLOAT_VALUE   : FLOAT;
          when STRING_FIELD =>
            STRING_VALUE  : STRING_LINK;
        end case;
      end record;

    type VALUE_LINK is access VALUE_TYPE;

    type VALUE_ARRAY is array(FIELD_INDEX range <>) of VALUE_LINK;

    type RECORD_TYPE(NUMBER_FIELDS : EXTENDED_FIELD_INDEX);

    type RECORD_LINK is access RECORD_TYPE;

    type RECORD_TYPE(NUMBER_FIELDS : EXTENDED_FIELD_INDEX) is
      record
        NEXT_RECORD : RECORD_LINK;
        VALUES      : VALUE_ARRAY(1..NUMBER_FIELDS);
      end record;

    type FIELD_TYPE is
      record
        NAME      : FIELD_NAME;
        DATA_TYPE : DATABASE_FIELD_TYPE;
        SIZE      : POSITIVE;
      end record;

    type FIELD_ARRAY is array(FIELD_INDEX range <>) of FIELD_TYPE;

    type TABLE_TYPE(NUMBER_FIELDS : EXTENDED_FIELD_INDEX) is
      record
        NAME    : TABLE_NAME;
        RECORDS : RECORD_LINK;
        FIELDS  : FIELD_ARRAY(1..NUMBER_FIELDS);
      end record;

    type TABLE_LINK is access TABLE_TYPE;

    type TABLE_ARRAY is array(TABLE_INDEX range <>) of TABLE_LINK;

    type DATABASE_TYPE is access TABLE_ARRAY;

  end SQL_FUNCTIONS;

  subtype DATABASE_TYPE is SQL_FUNCTIONS.DATABASE_TYPE;
  subtype CURSOR_TYPE   is SQL_FUNCTIONS.CURSOR_TYPE;
  subtype FIELD_INDEX   is SQL_FUNCTIONS.FIELD_INDEX;

  function EXECUTE(F : FIELD) return CURSOR_TYPE
      renames SQL_FUNCTIONS.EXECUTE;

  procedure EXECUTE(F : in FIELD) renames SQL_FUNCTIONS.EXECUTE;
  procedure LIST   (F : in FIELD) renames SQL_FUNCTIONS.LIST;
  procedure SHOW   (F : in FIELD) renames SQL_FUNCTIONS.SHOW;

  procedure SET_DATABASE(DB : in DATABASE_TYPE)
      renames SQL_FUNCTIONS.SET_DATABASE;

  procedure NEXT_RECORD(CURSOR : in out CURSOR_TYPE)
      renames SQL_FUNCTIONS.NEXT_RECORD;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  INT    : out INTEGER) renames SQL_FUNCTIONS.FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  FLT    : out FLOAT) renames SQL_FUNCTIONS.FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  STR    : out STRING;
                  LAST   : out NATURAL) renames SQL_FUNCTIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return INTEGER
      renames SQL_FUNCTIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return FLOAT
      renames SQL_FUNCTIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return STRING
      renames SQL_FUNCTIONS.FETCH;

  function  LOAD_DATABASE(FILE_NAME : in STRING) return DATABASE_TYPE renames
      SQL_FUNCTIONS.LOAD_DATABASE;

  procedure SAVE_DATABASE(FILE_NAME : in STRING;
                          DATABASE  : in DATABASE_TYPE) renames
      SQL_FUNCTIONS.SAVE_DATABASE;

  CALL_ERROR          : exception renames SQL_FUNCTIONS.CALL_ERROR;
  DONE_ERROR          : exception renames SQL_FUNCTIONS.DONE_ERROR;
  FIELD_ERROR         : exception renames SQL_FUNCTIONS.FIELD_ERROR;
  SYNTAX_ERROR        : exception renames SQL_FUNCTIONS.SYNTAX_ERROR;
  TABLE_ERROR         : exception renames SQL_FUNCTIONS.TABLE_ERROR;
  TRUNCATE_ERROR      : exception renames SQL_FUNCTIONS.TRUNCATE_ERROR;
  TYPE_ERROR          : exception renames SQL_FUNCTIONS.TYPE_ERROR;
  UNIMPLEMENTED_ERROR : exception renames SQL_FUNCTIONS.UNIMPLEMENTED_ERROR;

private

  type TABLE_NAME_STRING is new STRING;
  type FIELD_NAME_STRING is new STRING;

  type TABLE_NAME is access TABLE_NAME_STRING;
  type FIELD_NAME is access FIELD_NAME_STRING;

  type TABLE_REC;

  type TABLE is access TABLE_REC;

  type TABLE_REC is
    record
      NAME      : TABLE_NAME;
      NEXT_LINK : TABLE;
    end record;

  type FIELD_TYPE_TYPE is (OPERATOR, INTEGER_LITERAL, STRING_LITERAL,
    FLOAT_LITERAL, EMPTY, QUALIFIED_FIELD, UNQUALIFIED_FIELD, FROM_LIST);

  type FIELD_REC(FIELD_TYPE : FIELD_TYPE_TYPE);

  type FIELD is access FIELD_REC;

  type FIELD_REC(FIELD_TYPE : FIELD_TYPE_TYPE) is
    record
      ACROSS_LINK : FIELD;
      case FIELD_TYPE is
        when FROM_LIST =>
          TABLE_LINK    : TABLE;
        when OPERATOR =>
          OPCODE        : OPERATOR_TYPE;
          DOWN_LINK     : FIELD;
        when INTEGER_LITERAL =>
          INTEGER_VALUE : INTEGER;
        when STRING_LITERAL =>
          STRING_VALUE  : STRING_LINK;
        when FLOAT_LITERAL =>
          FLOAT_VALUE   : FLOAT;
        when EMPTY =>
          null;
        when QUALIFIED_FIELD | UNQUALIFIED_FIELD =>
          RELATION      : TABLE_NAME; -- null for UNQUALIFIED_FIELD
          NAME          : FIELD_NAME;
      end case;
    end record;

  STAR : constant FIELD := new FIELD_REC'(
    UNQUALIFIED_FIELD,null,null,new FIELD_NAME_STRING'("*"));

  NULL_TABLE : constant TABLE := null;
  NULL_FIELD : constant FIELD := null;

end SQL_DEFINITIONS;

package body SQL_DEFINITIONS is

  function MAKE_TABLE_NAME(NAME : STRING) return TABLE_NAME is
  begin
    return new TABLE_NAME_STRING'(TABLE_NAME_STRING(NAME));
  end;

  function MAKE_FIELD(RELATION : TABLE_NAME; TEMPLATE : FIELD) return FIELD is
  begin
    return new FIELD_REC'(QUALIFIED_FIELD,null,RELATION,TEMPLATE.NAME);
  end MAKE_FIELD;

  function MAKE_FIELD(NAME : STRING) return FIELD is
  begin
    return new FIELD_REC'(
      UNQUALIFIED_FIELD,null,null,
        new FIELD_NAME_STRING'(FIELD_NAME_STRING(NAME)) );
  end MAKE_FIELD;

  function TABLEIFY(F : FIELD) return TABLE is
  begin
    return new TABLE_REC'(F.RELATION,null);
  end TABLEIFY;

  function GET_TABLE return TABLE is
  begin
    return TABLEIFY(TABLE_FIELD);
  end GET_TABLE;

  function GET_FIELD_NAME return FIELD is
  begin
    return FIELD_NAME;
  end GET_FIELD_NAME;

  function GET_FIELDS return TABLE_TYPE is
  begin
    return DATA;
  end GET_FIELDS;

  function INSERT_FIELDS(F : in FIELD) return FIELD is
  begin
    return new FIELD_REC'(FROM_LIST,F,TABLEIFY(TABLE_FIELD));
  end INSERT_FIELDS;

  function FIELDIFY(F : FIELD) return FIELD is
  begin
    if F = null then
      return new FIELD_REC'(EMPTY,null);
    else
      case F.FIELD_TYPE is
        when QUALIFIED_FIELD | UNQUALIFIED_FIELD =>
          return new FIELD_REC'(F.all);
        when others =>
          return F;
      end case;
    end if;
  end FIELDIFY;

  function FIELDIFY(F : INTEGER) return FIELD is
  begin
    return new FIELD_REC'(INTEGER_LITERAL,null,F);
  end FIELDIFY;

  function FIELDIFY(F : FLOAT) return FIELD is
  begin
    return new FIELD_REC'(FLOAT_LITERAL,null,F);
  end FIELDIFY;

  function FIELDIFY(F : STRING) return FIELD is
  begin
    return new FIELD_REC'(STRING_LITERAL,null,new STRING'(F));
  end FIELDIFY;

  function VALUES_GEN(V : VALUE_TYPE) return FIELD is
  begin
    return FIELDIFY(V);
  end VALUES_GEN;

  function UNARY_OPERATOR(L : L_TYPE) return FIELD is
  begin
    return new FIELD_REC'(OPERATOR,null,OPCODE,L_FIELDIFY(L) );
  end UNARY_OPERATOR;

  function BINARY_OPERATOR(L : L_TYPE; R : R_TYPE) return FIELD is
    LF : FIELD;
  begin
    LF := L_FIELDIFY(L);
    LF.ACROSS_LINK := R_FIELDIFY(R);
    return new FIELD_REC'(OPERATOR,null,OPCODE,LF);
  end BINARY_OPERATOR;

  function SELEC(WHAT   : FIELD := NULL_FIELD;
                 FROM   : TABLE := NULL_TABLE;
                 WHERE  : FIELD := NULL_FIELD;
                 GROUP  : FIELD := NULL_FIELD;
                 HAVING : FIELD := NULL_FIELD;
                 ORDER  : FIELD := NULL_FIELD) return FIELD is
    RET_VALUE,F : FIELD;
  begin
    F := FIELDIFY(WHAT);
    RET_VALUE := new FIELD_REC'(OPERATOR,null,O_SELECT,F);
    F.ACROSS_LINK := new FIELD_REC'(FROM_LIST,null,FROM); F := F.ACROSS_LINK;
    F.ACROSS_LINK := FIELDIFY(WHERE); F := F.ACROSS_LINK;
    F.ACROSS_LINK := FIELDIFY(GROUP); F := F.ACROSS_LINK;
    F.ACROSS_LINK := FIELDIFY(HAVING); F := F.ACROSS_LINK;
    F.ACROSS_LINK := FIELDIFY(ORDER); F := F.ACROSS_LINK;
    return RET_VALUE;
  end SELEC;

  function INSERT_INTO(WHAT   : FIELD;
                       VALUES : FIELD) return FIELD is
  begin
    return new FIELD_REC'(OPERATOR,FIELDIFY(WHAT),O_INSERT,FIELDIFY(VALUES));
  end INSERT_INTO;

  function INSERT_INTO(WHAT   : TABLE;
                       VALUES : FIELD) return FIELD is
  begin
    return new FIELD_REC'(OPERATOR,new FIELD_REC'(FROM_LIST,null,WHAT),
        O_INSERT,FIELDIFY(VALUES));
  end INSERT_INTO;

  function INSERT_GEN(WHAT : WHAT_TYPE; VALUES : VALUE_TYPE) return FIELD is
  begin
    return INSERT_UNTO(WHAT,FIELDIFY(VALUES));
  end INSERT_GEN;

  function DELETE(FROM  : TABLE := NULL_TABLE;
                  WHERE : FIELD := NULL_FIELD) return FIELD is
  begin
    return new FIELD_REC'(OPERATOR,null,O_DELETE,
        new FIELD_REC'(FROM_LIST,FIELDIFY(WHERE),FROM));
  end DELETE;

  function UPDATE(WHAT  : TABLE := NULL_TABLE;
                  SET   : FIELD;
                  WHERE : FIELD := NULL_FIELD) return FIELD is
    RET_VALUE, F : FIELD;
  begin
    F := new FIELD_REC'(FROM_LIST,null,WHAT);
    RET_VALUE := new FIELD_REC'(OPERATOR,null,O_UPDATE,F);
    F.ACROSS_LINK := FIELDIFY(SET); F := F.ACROSS_LINK;
    F.ACROSS_LINK := FIELDIFY(WHERE);
    return RET_VALUE;
  end UPDATE;

  function "&"(L : TABLE; R : TABLE) return TABLE is
    LP : TABLE := L;
  begin
    while LP.NEXT_LINK /= null loop
      LP := LP.NEXT_LINK;
    end loop;
    LP.NEXT_LINK := R;
    return L;
  end "&";

  package body SQL_FUNCTIONS is separate;

end SQL_DEFINITIONS;

with TEXT_PRINT;
  use TEXT_PRINT;

separate(SQL_DEFINITIONS)
package body SQL_FUNCTIONS is

  package INT_PRINT is new INTEGER_PRINT(INTEGER);
  package FLT_PRINT is new FLOAT_PRINT(FLOAT);
    use INT_PRINT, FLT_PRINT;

  package body PROGRAM_FUNCTIONS is separate;
  package body SHOW_PACKAGE is separate;
  package body BULK_FUNCTIONS is separate;

end SQL_FUNCTIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sqlops.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SQL_DEFINITIONS;
  use SQL_DEFINITIONS;

package SQL_OPERATIONS is

  subtype TABLE is SQL_DEFINITIONS.TABLE;
  subtype FIELD is SQL_DEFINITIONS.FIELD;

  type STAR_TYPE is ('*');

  function SELEC(WHAT   : FIELD := NULL_FIELD;
                 FROM   : TABLE := NULL_TABLE;
                 WHERE  : FIELD := NULL_FIELD;
                 GROUP  : FIELD := NULL_FIELD;
                 HAVING : FIELD := NULL_FIELD;
                 ORDER  : FIELD := NULL_FIELD) return FIELD
    renames SQL_DEFINITIONS.SELEC;

  function SELEC(WHAT   : STAR_TYPE;
                 FROM   : TABLE := NULL_TABLE;
                 WHERE  : FIELD := NULL_FIELD;
                 GROUP  : FIELD := NULL_FIELD;
                 HAVING : FIELD := NULL_FIELD;
                 ORDER  : FIELD := NULL_FIELD) return FIELD;

  function INSERT_INTO(WHAT   : FIELD;
                       VALUES : FIELD) return FIELD
    renames SQL_DEFINITIONS.INSERT_INTO;

  function INSERT_INTO(WHAT   : TABLE;
                       VALUES : FIELD) return FIELD
    renames SQL_DEFINITIONS.INSERT_INTO;

  function INSERT_INTO is new INSERT_GEN(FIELD,INTEGER);
  function INSERT_INTO is new INSERT_GEN(FIELD,FLOAT);
  function INSERT_INTO is new INSERT_GEN(FIELD,STRING);
  function INSERT_INTO is new INSERT_GEN(TABLE,INTEGER);
  function INSERT_INTO is new INSERT_GEN(TABLE,FLOAT);
  function INSERT_INTO is new INSERT_GEN(TABLE,STRING);

  function DELETE(FROM  : TABLE := NULL_TABLE;
                  WHERE : FIELD := NULL_FIELD) return FIELD
    renames SQL_DEFINITIONS.DELETE;

  function UPDATE(WHAT  : TABLE := NULL_TABLE;
                  SET   : FIELD;
                  WHERE : FIELD := NULL_FIELD) return FIELD
    renames SQL_DEFINITIONS.UPDATE;

  function VALUES is new VALUES_GEN(FIELD);
  function VALUES is new VALUES_GEN(INTEGER);
  function VALUES is new VALUES_GEN(FLOAT);
  function VALUES is new VALUES_GEN(STRING);

  function LIKE is new BINARY_OPERATOR(O_LIKE,FIELD, FIELD);
  function LIKE is new BINARY_OPERATOR(O_LIKE,FIELD, STRING);
  function LIKE is new BINARY_OPERATOR(O_LIKE,STRING,FIELD);

  function SUM is new UNARY_OPERATOR(O_SUM,FIELD);
  function AVG is new UNARY_OPERATOR(O_AVG,FIELD);
  function MAX is new UNARY_OPERATOR(O_MAX,FIELD);
  function MIN is new UNARY_OPERATOR(O_MIN,FIELD);

  function COUNT is new UNARY_OPERATOR(O_COUNT,FIELD);
  function COUNT(X : STAR_TYPE) return FIELD;

  function IS_IN is new BINARY_OPERATOR(O_IN,FIELD,  FIELD);
  function IS_IN is new BINARY_OPERATOR(O_IN,INTEGER,FIELD);
  function IS_IN is new BINARY_OPERATOR(O_IN,FLOAT,  FIELD);
  function IS_IN is new BINARY_OPERATOR(O_IN,STRING, FIELD);

  function EXISTS is new UNARY_OPERATOR(O_EXISTS,FIELD);

  function DESC is new UNARY_OPERATOR(O_DESC,FIELD);

  function "and" is new BINARY_OPERATOR(O_AND,FIELD,FIELD);

  function "and" is new BINARY_OPERATOR(O_AND,INTEGER,INTEGER);
  function "and" is new BINARY_OPERATOR(O_AND,FLOAT,  FLOAT);
  function "and" is new BINARY_OPERATOR(O_AND,STRING, STRING);
  function "and" is new BINARY_OPERATOR(O_AND,INTEGER,FLOAT);
  function "and" is new BINARY_OPERATOR(O_AND,INTEGER,STRING);
  function "and" is new BINARY_OPERATOR(O_AND,FLOAT,  INTEGER);
  function "and" is new BINARY_OPERATOR(O_AND,FLOAT,  STRING);
  function "and" is new BINARY_OPERATOR(O_AND,STRING, INTEGER);
  function "and" is new BINARY_OPERATOR(O_AND,STRING, FLOAT);
  function "and" is new BINARY_OPERATOR(O_AND,INTEGER,FIELD);
  function "and" is new BINARY_OPERATOR(O_AND,FLOAT,  FIELD);
  function "and" is new BINARY_OPERATOR(O_AND,STRING, FIELD);
  function "and" is new BINARY_OPERATOR(O_AND,FIELD,  INTEGER);
  function "and" is new BINARY_OPERATOR(O_AND,FIELD,  FLOAT);
  function "and" is new BINARY_OPERATOR(O_AND,FIELD,  STRING);

  function "xor" is new BINARY_OPERATOR(O_XOR,FIELD,FIELD);

  function "or" is new BINARY_OPERATOR(O_OR,FIELD,FIELD);

  function "or" is new BINARY_OPERATOR(O_OR,INTEGER,INTEGER);
  function "or" is new BINARY_OPERATOR(O_OR,FLOAT,  FLOAT);
  function "or" is new BINARY_OPERATOR(O_OR,STRING, STRING);
  function "or" is new BINARY_OPERATOR(O_OR,INTEGER,FLOAT);
  function "or" is new BINARY_OPERATOR(O_OR,FLOAT,  INTEGER);
  function "or" is new BINARY_OPERATOR(O_OR,FIELD,  INTEGER);
  function "or" is new BINARY_OPERATOR(O_OR,FIELD,  FLOAT);
  function "or" is new BINARY_OPERATOR(O_OR,FIELD,  STRING);
  function "or" is new BINARY_OPERATOR(O_OR,INTEGER,FIELD);
  function "or" is new BINARY_OPERATOR(O_OR,FLOAT,  FIELD);
  function "or" is new BINARY_OPERATOR(O_OR,STRING, FIELD);

  function EQ is new BINARY_OPERATOR(O_EQ,FIELD,  FIELD);
  function EQ is new BINARY_OPERATOR(O_EQ,INTEGER,INTEGER);
  function EQ is new BINARY_OPERATOR(O_EQ,FLOAT  ,FLOAT);
  function EQ is new BINARY_OPERATOR(O_EQ,STRING, STRING);
  function EQ is new BINARY_OPERATOR(O_EQ,INTEGER,FLOAT);
  function EQ is new BINARY_OPERATOR(O_EQ,FLOAT,  INTEGER);
  function EQ is new BINARY_OPERATOR(O_EQ,FIELD,  INTEGER);
  function EQ is new BINARY_OPERATOR(O_EQ,FIELD,  FLOAT);
  function EQ is new BINARY_OPERATOR(O_EQ,FIELD,  STRING);
  function EQ is new BINARY_OPERATOR(O_EQ,INTEGER,FIELD);
  function EQ is new BINARY_OPERATOR(O_EQ,FLOAT,  FIELD);
  function EQ is new BINARY_OPERATOR(O_EQ,STRING, FIELD);

  function NE is new BINARY_OPERATOR(O_NE,FIELD,  FIELD);
  function NE is new BINARY_OPERATOR(O_NE,INTEGER,INTEGER);
  function NE is new BINARY_OPERATOR(O_NE,FLOAT,  FLOAT);
  function NE is new BINARY_OPERATOR(O_NE,STRING, STRING);
  function NE is new BINARY_OPERATOR(O_NE,INTEGER,FLOAT);
  function NE is new BINARY_OPERATOR(O_NE,FLOAT,  INTEGER);
  function NE is new BINARY_OPERATOR(O_NE,FIELD,  INTEGER);
  function NE is new BINARY_OPERATOR(O_NE,FIELD,  FLOAT);
  function NE is new BINARY_OPERATOR(O_NE,FIELD,  STRING);
  function NE is new BINARY_OPERATOR(O_NE,INTEGER,FIELD);
  function NE is new BINARY_OPERATOR(O_NE,FLOAT,  FIELD);
  function NE is new BINARY_OPERATOR(O_NE,STRING, FIELD);

  function "<" is new BINARY_OPERATOR(O_LT,FIELD,  FIELD);
  function "<" is new BINARY_OPERATOR(O_LT,INTEGER,INTEGER);
  function "<" is new BINARY_OPERATOR(O_LT,FLOAT,  FLOAT);
  function "<" is new BINARY_OPERATOR(O_LT,STRING, STRING);
  function "<" is new BINARY_OPERATOR(O_LT,INTEGER,FLOAT);
  function "<" is new BINARY_OPERATOR(O_LT,FLOAT,  INTEGER);
  function "<" is new BINARY_OPERATOR(O_LT,FIELD,  INTEGER);
  function "<" is new BINARY_OPERATOR(O_LT,FIELD,  FLOAT);
  function "<" is new BINARY_OPERATOR(O_LT,FIELD,  STRING);
  function "<" is new BINARY_OPERATOR(O_LT,INTEGER,FIELD);
  function "<" is new BINARY_OPERATOR(O_LT,FLOAT,  FIELD);
  function "<" is new BINARY_OPERATOR(O_LT,STRING, FIELD);

  function "<=" is new BINARY_OPERATOR(O_LE,FIELD,  FIELD);
  function "<=" is new BINARY_OPERATOR(O_LE,INTEGER,INTEGER);
  function "<=" is new BINARY_OPERATOR(O_LE,FLOAT,  FLOAT);
  function "<=" is new BINARY_OPERATOR(O_LE,STRING, STRING);
  function "<=" is new BINARY_OPERATOR(O_LE,INTEGER,FLOAT);
  function "<=" is new BINARY_OPERATOR(O_LE,FLOAT,  INTEGER);
  function "<=" is new BINARY_OPERATOR(O_LE,FIELD,  INTEGER);
  function "<=" is new BINARY_OPERATOR(O_LE,FIELD,  FLOAT);
  function "<=" is new BINARY_OPERATOR(O_LE,FIELD,  STRING);
  function "<=" is new BINARY_OPERATOR(O_LE,INTEGER,FIELD);
  function "<=" is new BINARY_OPERATOR(O_LE,FLOAT,  FIELD);
  function "<=" is new BINARY_OPERATOR(O_LE,STRING, FIELD);

  function ">" is new BINARY_OPERATOR(O_GT,FIELD,  FIELD);
  function ">" is new BINARY_OPERATOR(O_GT,INTEGER,INTEGER);
  function ">" is new BINARY_OPERATOR(O_GT,FLOAT,  FLOAT);
  function ">" is new BINARY_OPERATOR(O_GT,STRING, STRING);
  function ">" is new BINARY_OPERATOR(O_GT,INTEGER,FLOAT);
  function ">" is new BINARY_OPERATOR(O_GT,FLOAT,  INTEGER);
  function ">" is new BINARY_OPERATOR(O_GT,FIELD,  INTEGER);
  function ">" is new BINARY_OPERATOR(O_GT,FIELD,  FLOAT);
  function ">" is new BINARY_OPERATOR(O_GT,FIELD,  STRING);
  function ">" is new BINARY_OPERATOR(O_GT,INTEGER,FIELD);
  function ">" is new BINARY_OPERATOR(O_GT,FLOAT,  FIELD);
  function ">" is new BINARY_OPERATOR(O_GT,STRING, FIELD);

  function ">=" is new BINARY_OPERATOR(O_GE,FIELD,  FIELD);
  function ">=" is new BINARY_OPERATOR(O_GE,INTEGER,INTEGER);
  function ">=" is new BINARY_OPERATOR(O_GE,FLOAT,  FLOAT);
  function ">=" is new BINARY_OPERATOR(O_GE,STRING, STRING);
  function ">=" is new BINARY_OPERATOR(O_GE,INTEGER,FLOAT);
  function ">=" is new BINARY_OPERATOR(O_GE,FLOAT,  INTEGER);
  function ">=" is new BINARY_OPERATOR(O_GE,FIELD,  INTEGER);
  function ">=" is new BINARY_OPERATOR(O_GE,FIELD,  FLOAT);
  function ">=" is new BINARY_OPERATOR(O_GE,FIELD,  STRING);
  function ">=" is new BINARY_OPERATOR(O_GE,INTEGER,FIELD);
  function ">=" is new BINARY_OPERATOR(O_GE,FLOAT,  FIELD);
  function ">=" is new BINARY_OPERATOR(O_GE,STRING, FIELD);

  function "+" is new BINARY_OPERATOR(O_PLUS,FIELD,  FIELD);
  function "+" is new BINARY_OPERATOR(O_PLUS,INTEGER,INTEGER);
  function "+" is new BINARY_OPERATOR(O_PLUS,FLOAT,  FLOAT);
  function "+" is new BINARY_OPERATOR(O_PLUS,INTEGER,FLOAT);
  function "+" is new BINARY_OPERATOR(O_PLUS,FLOAT,  INTEGER);
  function "+" is new BINARY_OPERATOR(O_PLUS,FIELD,  INTEGER);
  function "+" is new BINARY_OPERATOR(O_PLUS,FIELD,  FLOAT);
  function "+" is new BINARY_OPERATOR(O_PLUS,INTEGER,FIELD);
  function "+" is new BINARY_OPERATOR(O_PLUS,FLOAT,  FIELD);

  function "-" is new BINARY_OPERATOR(O_MINUS,FIELD,  FIELD);
  function "-" is new BINARY_OPERATOR(O_MINUS,INTEGER,INTEGER);
  function "-" is new BINARY_OPERATOR(O_MINUS,FLOAT,  FLOAT);
  function "-" is new BINARY_OPERATOR(O_MINUS,INTEGER,FLOAT);
  function "-" is new BINARY_OPERATOR(O_MINUS,FLOAT,  INTEGER);
  function "-" is new BINARY_OPERATOR(O_MINUS,FIELD,  INTEGER);
  function "-" is new BINARY_OPERATOR(O_MINUS,FIELD,  FLOAT);
  function "-" is new BINARY_OPERATOR(O_MINUS,INTEGER,FIELD);
  function "-" is new BINARY_OPERATOR(O_MINUS,FLOAT,  FIELD);

  function "&"(L : TABLE; R : TABLE) return TABLE renames SQL_DEFINITIONS."&";

  function "&" is new BINARY_OPERATOR(O_CAT,FIELD,  FIELD);
  function "&" is new BINARY_OPERATOR(O_CAT,INTEGER,INTEGER);
  function "&" is new BINARY_OPERATOR(O_CAT,FLOAT,  FLOAT);
  function "&" is new BINARY_OPERATOR(O_CAT,STRING, STRING);
  function "&" is new BINARY_OPERATOR(O_CAT,INTEGER,FLOAT);
  function "&" is new BINARY_OPERATOR(O_CAT,INTEGER,STRING);
  function "&" is new BINARY_OPERATOR(O_CAT,FLOAT,  INTEGER);
  function "&" is new BINARY_OPERATOR(O_CAT,FLOAT,  STRING);
  function "&" is new BINARY_OPERATOR(O_CAT,STRING, INTEGER);
  function "&" is new BINARY_OPERATOR(O_CAT,STRING, FLOAT);
  function "&" is new BINARY_OPERATOR(O_CAT,INTEGER,FIELD);
  function "&" is new BINARY_OPERATOR(O_CAT,FLOAT,  FIELD);
  function "&" is new BINARY_OPERATOR(O_CAT,STRING, FIELD);
  function "&" is new BINARY_OPERATOR(O_CAT,FIELD,  INTEGER);
  function "&" is new BINARY_OPERATOR(O_CAT,FIELD,  FLOAT);
  function "&" is new BINARY_OPERATOR(O_CAT,FIELD,  STRING);

  function "+" is new UNARY_OPERATOR(O_UNARY_PLUS,FIELD);
  function "+" is new UNARY_OPERATOR(O_UNARY_PLUS,INTEGER);
  function "+" is new UNARY_OPERATOR(O_UNARY_PLUS,FLOAT);

  function "-" is new UNARY_OPERATOR(O_UNARY_MINUS,FIELD);
  function "-" is new UNARY_OPERATOR(O_UNARY_MINUS,INTEGER);
  function "-" is new UNARY_OPERATOR(O_UNARY_MINUS,FLOAT);

  function "*" is new BINARY_OPERATOR(O_TIMES,FIELD,  FIELD);
  function "*" is new BINARY_OPERATOR(O_TIMES,INTEGER,INTEGER);
  function "*" is new BINARY_OPERATOR(O_TIMES,FLOAT,  FLOAT);
  function "*" is new BINARY_OPERATOR(O_TIMES,INTEGER,FLOAT);
  function "*" is new BINARY_OPERATOR(O_TIMES,FLOAT,  INTEGER);
  function "*" is new BINARY_OPERATOR(O_TIMES,FIELD,  INTEGER);
  function "*" is new BINARY_OPERATOR(O_TIMES,FIELD,  FLOAT);
  function "*" is new BINARY_OPERATOR(O_TIMES,INTEGER,FIELD);
  function "*" is new BINARY_OPERATOR(O_TIMES,FLOAT,  FIELD);

  function "/" is new BINARY_OPERATOR(O_DIV,FIELD,  FIELD);
  function "/" is new BINARY_OPERATOR(O_DIV,INTEGER,INTEGER);
  function "/" is new BINARY_OPERATOR(O_DIV,FLOAT,  FLOAT);
  function "/" is new BINARY_OPERATOR(O_DIV,INTEGER,FLOAT);
  function "/" is new BINARY_OPERATOR(O_DIV,FLOAT,  INTEGER);
  function "/" is new BINARY_OPERATOR(O_DIV,FIELD,  INTEGER);
  function "/" is new BINARY_OPERATOR(O_DIV,FIELD,  FLOAT);
  function "/" is new BINARY_OPERATOR(O_DIV,INTEGER,FIELD);
  function "/" is new BINARY_OPERATOR(O_DIV,FLOAT,  FIELD);

  function "mod" is new BINARY_OPERATOR(O_MOD,FIELD,  FIELD);
  function "mod" is new BINARY_OPERATOR(O_MOD,INTEGER,INTEGER);
  function "mod" is new BINARY_OPERATOR(O_MOD,FIELD,  INTEGER);
  function "mod" is new BINARY_OPERATOR(O_MOD,INTEGER,FIELD);

  function "rem" is new BINARY_OPERATOR(O_REM,FIELD,  FIELD);
  function "rem" is new BINARY_OPERATOR(O_REM,INTEGER,INTEGER);
  function "rem" is new BINARY_OPERATOR(O_REM,FIELD,  INTEGER);
  function "rem" is new BINARY_OPERATOR(O_REM,INTEGER,FIELD);

  function "**" is new BINARY_OPERATOR(O_POWER,FIELD,  FIELD);
  function "**" is new BINARY_OPERATOR(O_POWER,INTEGER,INTEGER);
  function "**" is new BINARY_OPERATOR(O_POWER,FLOAT,  INTEGER);
  function "**" is new BINARY_OPERATOR(O_POWER,FIELD,  INTEGER);
  function "**" is new BINARY_OPERATOR(O_POWER,INTEGER,FIELD);
  function "**" is new BINARY_OPERATOR(O_POWER,FLOAT,  FIELD);

  function "abs" is new UNARY_OPERATOR(O_ABS,FIELD);
  function "abs" is new UNARY_OPERATOR(O_ABS,INTEGER);
  function "abs" is new UNARY_OPERATOR(O_ABS,FLOAT);

  function "not" is new UNARY_OPERATOR(O_NOT,FIELD);

  subtype DATABASE_TYPE is SQL_DEFINITIONS.DATABASE_TYPE;
  subtype CURSOR_TYPE   is SQL_DEFINITIONS.CURSOR_TYPE;
  subtype FIELD_INDEX   is SQL_DEFINITIONS.FIELD_INDEX;

  function EXECUTE(F : FIELD) return CURSOR_TYPE
      renames SQL_DEFINITIONS.EXECUTE;

  procedure EXECUTE(F : in FIELD) renames SQL_DEFINITIONS.EXECUTE;
  procedure LIST   (F : in FIELD) renames SQL_DEFINITIONS.LIST;
  procedure SHOW   (F : in FIELD) renames SQL_DEFINITIONS.SHOW;

  procedure SET_DATABASE(DB : in DATABASE_TYPE)
      renames SQL_DEFINITIONS.SET_DATABASE;

  procedure NEXT_RECORD(CURSOR : in out CURSOR_TYPE)
      renames SQL_DEFINITIONS.NEXT_RECORD;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  INT    : out INTEGER) renames SQL_DEFINITIONS.FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  FLT    : out FLOAT) renames SQL_DEFINITIONS.FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  STR    : out STRING;
                  LAST   : out NATURAL) renames SQL_DEFINITIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return INTEGER
      renames SQL_DEFINITIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return FLOAT
      renames SQL_DEFINITIONS.FETCH;

  function FETCH(CURSOR : CURSOR_TYPE;
                 FIELD  : FIELD_INDEX) return STRING
      renames SQL_DEFINITIONS.FETCH;

  function LOAD_DATABASE(FILE_NAME : in STRING) return DATABASE_TYPE
      renames SQL_DEFINITIONS.LOAD_DATABASE;

  procedure SAVE_DATABASE(FILE_NAME : in STRING;
                          DATABASE  : in DATABASE_TYPE)
      renames SQL_DEFINITIONS.SAVE_DATABASE;

  CALL_ERROR          : exception renames SQL_DEFINITIONS.CALL_ERROR;
  DONE_ERROR          : exception renames SQL_DEFINITIONS.DONE_ERROR;
  FIELD_ERROR         : exception renames SQL_DEFINITIONS.FIELD_ERROR;
  SYNTAX_ERROR        : exception renames SQL_DEFINITIONS.SYNTAX_ERROR;
  TABLE_ERROR         : exception renames SQL_DEFINITIONS.TABLE_ERROR;
  TRUNCATE_ERROR      : exception renames SQL_DEFINITIONS.TRUNCATE_ERROR;
  TYPE_ERROR          : exception renames SQL_DEFINITIONS.TYPE_ERROR;
  UNIMPLEMENTED_ERROR : exception renames SQL_DEFINITIONS.UNIMPLEMENTED_ERROR;

end SQL_OPERATIONS;

with SQL_DEFINITIONS;
  use SQL_DEFINITIONS;

package body SQL_OPERATIONS is

  function SELEC(WHAT   : STAR_TYPE;
                 FROM   : TABLE := NULL_TABLE;
                 WHERE  : FIELD := NULL_FIELD;
                 GROUP  : FIELD := NULL_FIELD;
                 HAVING : FIELD := NULL_FIELD;
                 ORDER  : FIELD := NULL_FIELD) return FIELD is
  begin
    return SELEC(STAR,FROM,WHERE,GROUP,HAVING,ORDER);
  end SELEC;

  function COUNT(X : STAR_TYPE) return FIELD is
  begin
    return COUNT(STAR);
  end COUNT;

end SQL_OPERATIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--dateund.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SQL_DEFINITIONS;
  use SQL_DEFINITIONS;

package DATE_UNDERLYING is

  type CELLAR_TYPE is
    record
      STAR, BIN, WINE, PRODUCER, YEAR, BOTTLES, READY, COMMENTS : FIELD;
    end record;

  type FLIGHTS_TYPE is
    record
      STAR, FLIGHT, FROM_CODE, TO_CODE, DEP_TIME, ARR_TIME : FIELD;
    end record;

  type CITIES_TYPE is
    record
      STAR, CODE, CITY : FIELD;
    end record;

  type PARCELS_TYPE is
    record
      STAR, APN, ROAD, OWNER, IMPROVED, LAST_ENTRY, BALANCE : FIELD;
    end record;

  type OWNERS_TYPE is
    record
      STAR, OWNER, ADDRESS, PHONE : FIELD;
    end record;

  type PARCEL_ACCOUNTS_TYPE is
    record
      STAR, APN, EN_TRY, DATE, DESCRIPTION, TYP, AMOUNT, BALANCE : FIELD;
    end record;

  type SPECIAL_ASSESSMENTS_TYPE is
    record
      STAR, SAN, ROAD, DATE, TOTAL, PER_PARCEL, EXPLANATION, PAYEE : FIELD;
    end record;

  type LEDGER_TYPE is
    record
      STAR, EN_TRY, DATE, DESCRIPTION, TYP, PARTY, AMOUNT, BALANCE : FIELD;
    end record;

  type GENERAL_LEDGER_TYPE is new LEDGER_TYPE;
  type REDWOOD_LEDGER_TYPE is new LEDGER_TYPE;
  type CREEK_LEDGER_TYPE   is new LEDGER_TYPE;
  type MILL_LEDGER_TYPE    is new LEDGER_TYPE;

  type LAST_ENTRIES_TYPE is
    record
      STAR, ACCOUNT, EN_TRY, BALANCE : FIELD;
    end record;

  type CELLAR_TABLE              is access CELLAR_TYPE;
  type FLIGHTS_TABLE             is access FLIGHTS_TYPE;
  type CITIES_TABLE              is access CITIES_TYPE;
  type PARCELS_TABLE             is access PARCELS_TYPE;
  type OWNERS_TABLE              is access OWNERS_TYPE;
  type PARCEL_ACCOUNTS_TABLE     is access PARCEL_ACCOUNTS_TYPE;
  type SPECIAL_ASSESSMENTS_TABLE is access SPECIAL_ASSESSMENTS_TYPE;
  type GENERAL_LEDGER_TABLE      is access GENERAL_LEDGER_TYPE;
  type REDWOOD_LEDGER_TABLE      is access REDWOOD_LEDGER_TYPE;
  type CREEK_LEDGER_TABLE        is access CREEK_LEDGER_TYPE;
  type MILL_LEDGER_TABLE         is access MILL_LEDGER_TYPE;
  type LAST_ENTRIES_TABLE        is access LAST_ENTRIES_TYPE;

  BIN         : constant FIELD := MAKE_FIELD("BIN");
  WINE        : constant FIELD := MAKE_FIELD("WINE");
  PRODUCER    : constant FIELD := MAKE_FIELD("PRODUCER");
  YEAR        : constant FIELD := MAKE_FIELD("YEAR");
  BOTTLES     : constant FIELD := MAKE_FIELD("BOTTLES");
  READY       : constant FIELD := MAKE_FIELD("READY");
  COMMENTS    : constant FIELD := MAKE_FIELD("COMMENTS");
  FLIGHT      : constant FIELD := MAKE_FIELD("FLIGHT");
  FROM_CODE   : constant FIELD := MAKE_FIELD("FROM_CODE");
  TO_CODE     : constant FIELD := MAKE_FIELD("TO_CODE");
  DEP_TIME    : constant FIELD := MAKE_FIELD("DEP_TIME");
  ARR_TIME    : constant FIELD := MAKE_FIELD("ARR_TIME");
  CODE        : constant FIELD := MAKE_FIELD("CODE");
  CITY        : constant FIELD := MAKE_FIELD("CITY");
  APN         : constant FIELD := MAKE_FIELD("APN");
  ROAD        : constant FIELD := MAKE_FIELD("ROAD");
  OWNER       : constant FIELD := MAKE_FIELD("OWNER");
  IMPROVED    : constant FIELD := MAKE_FIELD("IMPROVED");
  LAST_ENTRY  : constant FIELD := MAKE_FIELD("LAST_ENTRY");
  BALANCE     : constant FIELD := MAKE_FIELD("BALANCE");
  ADDRESS     : constant FIELD := MAKE_FIELD("ADDRESS");
  PHONE       : constant FIELD := MAKE_FIELD("PHONE");
  EN_TRY      : constant FIELD := MAKE_FIELD("ENTRY");
  DATE        : constant FIELD := MAKE_FIELD("DATE");
  DESCRIPTION : constant FIELD := MAKE_FIELD("DESCRIPTION");
  TYP         : constant FIELD := MAKE_FIELD("TYPE");
  AMOUNT      : constant FIELD := MAKE_FIELD("AMOUNT");
  SAN         : constant FIELD := MAKE_FIELD("SAN");
  TOTAL       : constant FIELD := MAKE_FIELD("TOTAL");
  PER_PARCEL  : constant FIELD := MAKE_FIELD("PER_PARCEL");
  EXPLANATION : constant FIELD := MAKE_FIELD("EXPLANATION");
  PAYEE       : constant FIELD := MAKE_FIELD("PAYEE");
  PARTY       : constant FIELD := MAKE_FIELD("PARTY");
  ACCOUNT     : constant FIELD := MAKE_FIELD("ACCOUNT");

  CELLAR_DATA              : CELLAR_TABLE;
  FLIGHTS_DATA             : FLIGHTS_TABLE;
  CITIES_DATA              : CITIES_TABLE;
  PARCELS_DATA             : PARCELS_TABLE;
  OWNERS_DATA              : OWNERS_TABLE;
  PARCEL_ACCOUNTS_DATA     : PARCEL_ACCOUNTS_TABLE;
  SPECIAL_ASSESSMENTS_DATA : SPECIAL_ASSESSMENTS_TABLE;
  GENERAL_LEDGER_DATA      : GENERAL_LEDGER_TABLE;
  REDWOOD_LEDGER_DATA      : REDWOOD_LEDGER_TABLE;
  CREEK_LEDGER_DATA        : CREEK_LEDGER_TABLE;
  MILL_LEDGER_DATA         : MILL_LEDGER_TABLE;
  LAST_ENTRIES_DATA        : LAST_ENTRIES_TABLE;

  procedure CELLAR             (X : in out CELLAR_TABLE);
  procedure FLIGHTS            (X : in out FLIGHTS_TABLE);
  procedure CITIES             (X : in out CITIES_TABLE);
  procedure PARCELS            (X : in out PARCELS_TABLE);
  procedure OWNERS             (X : in out OWNERS_TABLE);
  procedure PARCEL_ACCOUNTS    (X : in out PARCEL_ACCOUNTS_TABLE);
  procedure SPECIAL_ASSESSMENTS(X : in out SPECIAL_ASSESSMENTS_TABLE);
  procedure GENERAL_LEDGER     (X : in out GENERAL_LEDGER_TABLE);
  procedure REDWOOD_LEDGER     (X : in out REDWOOD_LEDGER_TABLE);
  procedure CREEK_LEDGER       (X : in out CREEK_LEDGER_TABLE);
  procedure MILL_LEDGER        (X : in out MILL_LEDGER_TABLE);
  procedure LAST_ENTRIES       (X : in out LAST_ENTRIES_TABLE);

end DATE_UNDERLYING;

with SQL_DEFINITIONS;
  use SQL_DEFINITIONS;

package body DATE_UNDERLYING is

  procedure CELLAR(X : in out CELLAR_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("CELLAR");
      X := new CELLAR_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,BIN),
        MAKE_FIELD(T,WINE),
        MAKE_FIELD(T,PRODUCER),
        MAKE_FIELD(T,YEAR),
        MAKE_FIELD(T,BOTTLES),
        MAKE_FIELD(T,READY),
        MAKE_FIELD(T,COMMENTS) );
    end if;
  end CELLAR;

  procedure FLIGHTS(X : in out FLIGHTS_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("FLIGHTS");
      X := new FLIGHTS_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,FLIGHT),
        MAKE_FIELD(T,FROM_CODE),
        MAKE_FIELD(T,TO_CODE),
        MAKE_FIELD(T,DEP_TIME),
        MAKE_FIELD(T,ARR_TIME) );
    end if;
  end FLIGHTS;

  procedure CITIES(X : in out CITIES_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("CITIES");
      X := new CITIES_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,CODE),
        MAKE_FIELD(T,CITY) );
    end if;
  end CITIES;

  procedure PARCELS(X : in out PARCELS_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("PARCELS");
      X := new PARCELS_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,APN),
        MAKE_FIELD(T,ROAD),
        MAKE_FIELD(T,OWNER),
        MAKE_FIELD(T,IMPROVED),
        MAKE_FIELD(T,LAST_ENTRY),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end PARCELS;

  procedure OWNERS(X : in out OWNERS_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("OWNERS");
      X := new OWNERS_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,OWNER),
        MAKE_FIELD(T,ADDRESS),
        MAKE_FIELD(T,PHONE) );
    end if;
  end OWNERS;

  procedure PARCEL_ACCOUNTS(X : in out PARCEL_ACCOUNTS_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("PARCEL_ACCOUNTS");
      X := new PARCEL_ACCOUNTS_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,APN),
        MAKE_FIELD(T,EN_TRY),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,DESCRIPTION),
        MAKE_FIELD(T,TYP),
        MAKE_FIELD(T,AMOUNT),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end PARCEL_ACCOUNTS;

  procedure SPECIAL_ASSESSMENTS(X : in out SPECIAL_ASSESSMENTS_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("SPECIAL_ASSESSMENTS");
      X := new SPECIAL_ASSESSMENTS_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,SAN),
        MAKE_FIELD(T,ROAD),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,TOTAL),
        MAKE_FIELD(T,PER_PARCEL),
        MAKE_FIELD(T,EXPLANATION),
        MAKE_FIELD(T,PAYEE) );
    end if;
  end SPECIAL_ASSESSMENTS;

  procedure GENERAL_LEDGER(X : in out GENERAL_LEDGER_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("GENERAL_LEDGER");
      X := new GENERAL_LEDGER_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,EN_TRY),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,DESCRIPTION),
        MAKE_FIELD(T,TYP),
        MAKE_FIELD(T,PARTY),
        MAKE_FIELD(T,AMOUNT),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end GENERAL_LEDGER;

  procedure REDWOOD_LEDGER(X : in out REDWOOD_LEDGER_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("REDWOOD_LEDGER");
      X := new RED_FIELD(T,EN_TRY),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,DESCRIPTION),
        MAKE_FIELD(T,TYP),
        MAKE_FIELD(T,PARTY),
        MAKE_FIELD(T,AMOUNT),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end REDWOOD_LEDGER;

  procedure CREEK_LEDGER(X : in out CREEK_LEDGER_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("CREEK_LEDGER");
      X := new CREEK_LEDGER_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,EN_TRY),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,DESCRIPTION),
        MAKE_FIELD(T,TYP),
        MAKE_FIELD(T,PARTY),
        MAKE_FIELD(T,AMOUNT),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end CREEK_LEDGER;

  procedure MILL_LEDGER(X : in out MILL_LEDGER_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("MILL_LEDGER");
      X := new MILL_LEDGER_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,EN_TRY),
        MAKE_FIELD(T,DATE),
        MAKE_FIELD(T,DESCRIPTION),
        MAKE_FIELD(T,TYP),
        MAKE_FIELD(T,PARTY),
        MAKE_FIELD(T,AMOUNT),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end MILL_LEDGER;

  procedure LAST_ENTRIES(X : in out LAST_ENTRIES_TABLE) is
    T : TABLE_NAME;
  begin
    if X = null then
      T := MAKE_TABLE_NAME("LAST_ENTRIES");
      X := new LAST_ENTRIES_TYPE'(
        MAKE_FIELD(T,STAR),
        MAKE_FIELD(T,ACCOUNT),
        MAKE_FIELD(T,EN_TRY),
        MAKE_FIELD(T,BALANCE) );
    end if;
  end LAST_ENTRIES;

begin

  CELLAR             (CELLAR_DATA);
  FLIGHTS            (FLIGHTS_DATA);
  CITIES             (CITIES_DATA);
  PARCELS            (PARCELS_DATA);
  OWNERS             (OWNERS_DATA);
  PARCEL_ACCOUNTS    (PARCEL_ACCOUNTS_DATA);
  SPECIAL_ASSESSMENTS(SPECIAL_ASSESSMENTS_DATA);
  GENERAL_LEDGER     (GENERAL_LEDGER_DATA);
  REDWOOD_LEDGER     (REDWOOD_LEDGER_DATA);
  CREEK_LEDGER       (CREEK_LEDGER_DATA);
  MILL_LEDGER        (MILL_LEDGER_DATA);
  LAST_ENTRIES       (LAST_ENTRIES_DATA);

end DATE_UNDERLYING;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--datedb.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with SQL_DEFINITIONS, DATE_UNDERLYING;
  use SQL_DEFINITIONS, DATE_UNDERLYING;

package DATE_DATABASE is

  subtype CELLAR_TYPE              is DATE_UNDERLYING.CELLAR_TYPE;
  subtype FLIGHTS_TYPE             is DATE_UNDERLYING.FLIGHTS_TYPE;
  subtype CITIES_TYPE              is DATE_UNDERLYING.CITIES_TYPE;
  subtype PARCELS_TYPE             is DATE_UNDERLYING.PARCELS_TYPE;
  subtype OWNERS_TYPE              is DATE_UNDERLYING.OWNERS_TYPE;
  subtype PARCEL_ACCOUNTS_TYPE     is DATE_UNDERLYING.PARCEL_ACCOUNTS_TYPE;
  subtype SPECIAL_ASSESSMENTS_TYPE is DATE_UNDERLYING.SPECIAL_ASSESSMENTS_TYPE;
  subtype GENERAL_LEDGER_TYPE      is DATE_UNDERLYING.GENERAL_LEDGER_TYPE;
  subtype REDWOOD_LEDGER_TYPE      is DATE_UNDERLYING.REDWOOD_LEDGER_TYPE;
  subtype CREEK_LEDGER_TYPE        is DATE_UNDERLYING.CREEK_LEDGER_TYPE;
  subtype MILL_LEDGER_TYPE         is DATE_UNDERLYING.MILL_LEDGER_TYPE;
  subtype LAST_ENTRIES_TYPE        is DATE_UNDERLYING.LAST_ENTRIES_TYPE;

  subtype CELLAR_TABLE          is DATE_UNDERLYING.CELLAR_TABLE;
  subtype FLIGHTS_TABLE         is DATE_UNDERLYING.FLIGHTS_TABLE;
  subtype CITIES_TABLE          is DATE_UNDERLYING.CITIES_TABLE;
  subtype PARCELS_TABLE         is DATE_UNDERLYING.PARCELS_TABLE;
  subtype OWNERS_TABLE          is DATE_UNDERLYING.OWNERS_TABLE;
  subtype PARCEL_ACCOUNTS_TABLE is DATE_UNDERLYING.PARCEL_ACCOUNTS_TABLE;
  subtype SPECIAL_ASSESSMENTS_TABLE is
    DATE_UNDERLYING.SPECIAL_ASSESSMENTS_TABLE;
  subtype GENERAL_LEDGER_TABLE is DATE_UNDERLYING.GENERAL_LEDGER_TABLE;
  subtype REDWOOD_LEDGER_TABLE is DATE_UNDERLYING.REDWOOD_LEDGER_TABLE;
  subtype CREEK_LEDGER_TABLE   is DATE_UNDERLYING.CREEK_LEDGER_TABLE;
  subtype MILL_LEDGER_TABLE    is DATE_UNDERLYING.MILL_LEDGER_TABLE;
  subtype LAST_ENTRIES_TABLE   is DATE_UNDERLYING.LAST_ENTRIES_TABLE;

  BIN         : FIELD renames DATE_UNDERLYING.BIN;
  WINE        : FIELD renames DATE_UNDERLYING.WINE;
  PRODUCER    : FIELD renames DATE_UNDERLYING.PRODUCER;
  YEAR        : FIELD renames DATE_UNDERLYING.YEAR;
  BOTTLES     : FIELD renames DATE_UNDERLYING.BOTTLES;
  READY       : FIELD renames DATE_UNDERLYING.READY;
  COMMENTS    : FIELD renames DATE_UNDERLYING.COMMENTS;
  FLIGHT      : FIELD renames DATE_UNDERLYING.FLIGHT;
  FROM_CODE   : FIELD renames DATE_UNDERLYING.FROM_CODE;
  TO_CODE     : FIELD renames DATE_UNDERLYING.TO_CODE;
  DEP_TIME    : FIELD renames DATE_UNDERLYING.DEP_TIME;
  ARR_TIME    : FIELD renames DATE_UNDERLYING.ARR_TIME;
  CODE        : FIELD renames DATE_UNDERLYING.CODE;
  CITY        : FIELD renames DATE_UNDERLYING.CITY;
  APN         : FIELD renames DATE_UNDERLYING.APN;
  ROAD        : FIELD renames DATE_UNDERLYING.ROAD;
  OWNER       : FIELD renames DATE_UNDERLYING.OWNER;
  IMPROVED    : FIELD renames DATE_UNDERLYING.IMPROVED;
  LAST_ENTRY  : FIELD renames DATE_UNDERLYING.LAST_ENTRY;
  BALANCE     : FIELD renames DATE_UNDERLYING.BALANCE;
  ADDRESS     : FIELD renames DATE_UNDERLYING.ADDRESS;
  PHONE       : FIELD renames DATE_UNDERLYING.PHONE;
  EN_TRY      : FIELD renames DATE_UNDERLYING.EN_TRY;
  DATE        : FIELD renames DATE_UNDERLYING.DATE;
  DESCRIPTION : FIELD renames DATE_UNDERLYING.DESCRIPTION;
  TYP         : FIELD renames DATE_UNDERLYING.TYP;
  AMOUNT      : FIELD renames DATE_UNDERLYING.AMOUNT;
  SAN         : FIELD renames DATE_UNDERLYING.SAN;
  TOTAL       : FIELD renames DATE_UNDERLYING.TOTAL;
  PER_PARCEL  : FIELD renames DATE_UNDERLYING.PER_PARCEL;
  EXPLANATION : FIELD renames DATE_UNDERLYING.EXPLANATION;
  PAYEE       : FIELD renames DATE_UNDERLYING.PAYEE;
  PARTY       : FIELD renames DATE_UNDERLYING.PARTY;
  ACCOUNT     : FIELD renames DATE_UNDERLYING.ACCOUNT;

  function CELLAR              is new GET_TABLE(CELLAR_DATA.STAR);
  function FLIGHTS             is new GET_TABLE(FLIGHTS_DATA.STAR);
  function CITIES              is new GET_TABLE(CITIES_DATA.STAR);
  function PARCELS             is new GET_TABLE(PARCELS_DATA.STAR);
  function OWNERS              is new GET_TABLE(OWNERS_DATA.STAR);
  function PARCEL_ACCOUNTS     is new GET_TABLE(PARCEL_ACCOUNTS_DATA.STAR);
  function SPECIAL_ASSESSMENTS is new GET_TABLE(SPECIAL_ASSESSMENTS_DATA.STAR);
  function GENERAL_LEDGER      is new GET_TABLE(GENERAL_LEDGER_DATA.STAR);
  function REDWOOD_LEDGER      is new GET_TABLE(REDWOOD_LEDGER_DATA.STAR);
  function CREEK_LEDGER        is new GET_TABLE(CREEK_LEDGER_DATA.STAR);
  function MILL_LEDGER         is new GET_TABLE(MILL_LEDGER_DATA.STAR);
  function LAST_ENTRIES        is new GET_TABLE(LAST_ENTRIES_DATA.STAR);

  function CELLAR  is new GET_FIELDS(CELLAR_TABLE,CELLAR_DATA);
  function FLIGHTS is new GET_FIELDS(FLIGHTS_TABLE,FLIGHTS_DATA);
  function CITIES  is new GET_FIELDS(CITIES_TABLE,CITIES_DATA);
  function PARCELS is new GET_FIELDS(PARCELS_TABLE,PARCELS_DATA);
  function OWNERS  is new GET_FIELDS(OWNERS_TABLE,OWNERS_DATA);
  function PARCEL_ACCOUNTS is
    new GET_FIELDS(PARCEL_ACCOUNTS_TABLE,PARCEL_ACCOUNTS_DATA);
  function SPECIAL_ASSESSMENTS is
    new GET_FIELDS(SPECIAL_ASSESSMENTS_TABLE,SPECIAL_ASSESSMENTS_DATA);
  function GENERAL_LEDGER is
    new GET_FIELDS(GENERAL_LEDGER_TABLE,GENERAL_LEDGER_DATA);
  function REDWOOD_LEDGER is
    new GET_FIELDS(REDWOOD_LEDGER_TABLE,REDWOOD_LEDGER_DATA);
  function CREEK_LEDGER is
    new GET_FIELDS(CREEK_LEDGER_TABLE,CREEK_LEDGER_DATA);
  function MILL_LEDGER is
    new GET_FIELDS(MILL_LEDGER_TABLE,MILL_LEDGER_DATA);
  function LAST_ENTRIES is
    new GET_FIELDS(LAST_ENTRIES_TABLE,LAST_ENTRIES_DATA);

  function CELLAR          is new INSERT_FIELDS(CELLAR_DATA.STAR);
  function FLIGHTS         is new INSERT_FIELDS(FLIGHTS_DATA.STAR);
  function CITIES          is new INSERT_FIELDS(CITIES_DATA.STAR);
  function PARCELS         is new INSERT_FIELDS(PARCELS_DATA.STAR);
  function OWNERS          is new INSERT_FIELDS(OWNERS_DATA.STAR);
  function PARCEL_ACCOUNTS is new INSERT_FIELDS(PARCEL_ACCOUNTS_DATA.STAR);
  function SPECIAL_ASSESSMENTS is
    new INSERT_FIELDS(SPECIAL_ASSESSMENTS_DATA.STAR);
  function GENERAL_LEDGER is new INSERT_FIELDS(GENERAL_LEDGER_DATA.STAR);
  function REDWOOD_LEDGER is new INSERT_FIELDS(REDWOOD_LEDGER_DATA.STAR);
  function CREEK_LEDGER   is new INSERT_FIELDS(CREEK_LEDGER_DATA.STAR);
  function MILL_LEDGER    is new INSERT_FIELDS(MILL_LEDGER_DATA.STAR);
  function LAST_ENTRIES   is new INSERT_FIELDS(LAST_ENTRIES_DATA.STAR);

  procedure CELLAR (X : in out CELLAR_TABLE)  renames DATE_UNDERLYING.CELLAR;
  procedure FLIGHTS(X : in out FLIGHTS_TABLE) renames DATE_UNDERLYING.FLIGHTS;
  procedure CITIES (X : in out CITIES_TABLE)  renames DATE_UNDERLYING.CITIES;
  procedure PARCELS(X : in out PARCELS_TABLE) renames DATE_UNDERLYING.PARCELS;
  procedure OWNERS (X : in out OWNERS_TABLE)  renames DATE_UNDERLYING.OWNERS;
  procedure PARCEL_ACCOUNTS(X : in out PARCEL_ACCOUNTS_TABLE) renames
    DATE_UNDERLYING.PARCEL_ACCOUNTS;
  procedure SPECIAL_ASSESSMENTS(X : in out SPECIAL_ASSESSMENTS_TABLE) renames
    DATE_UNDERLYING.SPECIAL_ASSESSMENTS;
  procedure GENERAL_LEDGER(X : in out GENERAL_LEDGER_TABLE) renames
    DATE_UNDERLYING.GENERAL_LEDGER;
  procedure REDWOOD_LEDGER(X : in out REDWOOD_LEDGER_TABLE) renames
    DATE_UNDERLYING.REDWOOD_LEDGER;
  procedure CREEK_LEDGER(X : in out CREEK_LEDGER_TABLE) renames
    DATE_UNDERLYING.CREEK_LEDGER;
  procedure MILL_LEDGER(X : in out MILL_LEDGER_TABLE) renames
    DATE_UNDERLYING.MILL_LEDGER;
  procedure LAST_ENTRIES(X : in out LAST_ENTRIES_TABLE) renames
    DATE_UNDERLYING.LAST_ENTRIES;

  function CELLAR             (X : CELLAR_TABLE)              return TABLE;
  function FLIGHTS            (X : FLIGHTS_TABLE)             return TABLE;
  function CITIES             (X : CITIES_TABLE)              return TABLE;
  function PARCELS            (X : PARCELS_TABLE)             return TABLE;
  function OWNERS             (X : OWNERS_TABLE)              return TABLE;
  function PARCEL_ACCOUNTS    (X : PARCEL_ACCOUNTS_TABLE)     return TABLE;
  function SPECIAL_ASSESSMENTS(X : SPECIAL_ASSESSMENTS_TABLE) return TABLE;
  function GENERAL_LEDGER     (X : GENERAL_LEDGER_TABLE)      return TABLE;
  function REDWOOD_LEDGER     (X : REDWOOD_LEDGER_TABLE)      return TABLE;
  function CREEK_LEDGER       (X : CREEK_LEDGER_TABLE)        return TABLE;
  function MILL_LEDGER        (X : MILL_LEDGER_TABLE)         return TABLE;
  function LAST_ENTRIES       (X : LAST_ENTRIES_TABLE)        return TABLE;

end DATE_DATABASE;

with SQL_DEFINITIONS, DATE_UNDERLYING;
  use SQL_DEFINITIONS, DATE_UNDERLYING;

package body DATE_DATABASE is

  function CELLAR(X : in CELLAR_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end CELLAR;

  function FLIGHTS(X : in FLIGHTS_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end FLIGHTS;

  function CITIES(X : in CITIES_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end CITIES;

  function PARCELS(X : in PARCELS_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end PARCELS;

  function OWNERS(X : in OWNERS_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end OWNERS;

  function PARCEL_ACCOUNTS(X : in PARCEL_ACCOUNTS_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end PARCEL_ACCOUNTS;

  function SPECIAL_ASSESSMENTS(X : in SPECIAL_ASSESSMENTS_TABLE) return TABLE
    is
  begin
    return TABLEIFY(X.STAR);
  end SPECIAL_ASSESSMENTS;

  function GENERAL_LEDGER(X : in GENERAL_LEDGER_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end GENERAL_LEDGER;

  function REDWOOD_LEDGER(X : in REDWOOD_LEDGER_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end REDWOOD_LEDGER;

  function CREEK_LEDGER(X : in CREEK_LEDGER_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end CREEK_LEDGER;

  function MILL_LEDGER(X : in MILL_LEDGER_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end MILL_LEDGER;

  function LAST_ENTRIES(X : in LAST_ENTRIES_TABLE) return TABLE is
  begin
    return TABLEIFY(X.STAR);
  end LAST_ENTRIES;

end DATE_DATABASE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--pgmfunc.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
separate(SQL_DEFINITIONS.SQL_FUNCTIONS)
package body PROGRAM_FUNCTIONS is

  DATABASE : DATABASE_TYPE;

  MATCHING_TYPES : constant array(DATABASE_FIELD_TYPE) of FIELD_TYPE_TYPE :=
    ( INTEGER_FIELD => INTEGER_LITERAL,
      FLOAT_FIELD   => FLOAT_LITERAL,
      STRING_FIELD  => STRING_LITERAL);

  function EQUAL(LEFT, RIGHT : VALUE_LINK) return BOOLEAN is
  begin
    case LEFT.FIELD_TYPE is
      when STRING_FIELD =>
        return LEFT.STRING_VALUE.all = RIGHT.STRING_VALUE.all;
      when others =>
        return LEFT.all = RIGHT.all;
    end case;
  exception
    when CONSTRAINT_ERROR =>
      return FALSE;
  end EQUAL;

  function FIND_TABLE(TABLE : TABLE_NAME)
      return TABLE_LINK is
  begin
    for I in 1..DATABASE'LAST loop
      if TABLE.all = DATABASE(I).NAME.all then
        return DATABASE(I);
      end if;
    end loop;
    raise TABLE_ERROR;
  end FIND_TABLE;

  function FIND_FIELD(TABLE : TABLE_LINK; FIELD : FIELD_NAME)
      return FIELD_INDEX is
  begin
    for I in 1..TABLE.FIELDS'LAST loop
      if FIELD.all = TABLE.FIELDS(I).NAME.all then
        return I;
      end if;
    end loop;
    raise FIELD_ERROR;
  end FIND_FIELD;

  function CREATE_LITERAL_VALUE(VALUE : FIELD) return VALUE_LINK is
  begin
    case VALUE.FIELD_TYPE is
      when INTEGER_LITERAL =>
        return new VALUE_TYPE'(INTEGER_FIELD,VALUE.INTEGER_VALUE);
      when FLOAT_LITERAL =>
        return new VALUE_TYPE'(FLOAT_FIELD,VALUE.FLOAT_VALUE);
      when STRING_LITERAL =>
        return new VALUE_TYPE'(STRING_FIELD,VALUE.STRING_VALUE);
      when others =>
        raise UNIMPLEMENTED_ERROR;
    end case;
  end CREATE_LITERAL_VALUE;

  procedure BUILD_WHERE(CURSOR   : in out CURSOR_TYPE;
                        WHERE    : in FIELD;
                        FROM     : in TABLE_LINK) is
    FIELD_NUMBER : FIELD_INDEX;
    TARGET_TYPE  : DATABASE_FIELD_TYPE;
    LEFT,
    RIGHT        : FIELD;
  begin
    case WHERE.FIELD_TYPE is
      when EMPTY =>
        return;
      when OPERATOR =>
        null;
      when others =>
        raise SYNTAX_ERROR;
    end case;
    LEFT := WHERE.DOWN_LINK;
    RIGHT := LEFT.ACROSS_LINK;
    case WHERE.OPCODE is
      when O_AND =>
        BUILD_WHERE(CURSOR,RIGHT,FROM);
        BUILD_WHERE(CURSOR,LEFT,FROM);
      when O_EQ =>
        case LEFT.FIELD_TYPE is
          when QUALIFIED_FIELD =>
            if LEFT.RELATION.all /= FROM.NAME.all then
              raise FIELD_ERROR;
            end if;
          when UNQUALIFIED_FIELD =>
            null;
          when others =>
            raise UNIMPLEMENTED_ERROR;
        end case;
        FIELD_NUMBER := FIND_FIELD(FROM,LEFT.NAME);
        TARGET_TYPE := FROM.FIELDS(FIELD_NUMBER).DATA_TYPE;
        if RIGHT.FIELD_TYPE /=
            MATCHING_TYPES(TARGET_TYPE) then
          raise UNIMPLEMENTED_ERROR;
        end if;
        CURSOR.QUERY := new QUERY_NODE_REC'(CURSOR.QUERY,FIELD_NUMBER,
            CREATE_LITERAL_VALUE(RIGHT));
      when others =>
        raise UNIMPLEMENTED_ERROR;
    end case;
  end BUILD_WHERE;

  function EXECUTE(F : FIELD) return CURSOR_TYPE is
    WHAT,
    FROM_FIELD,
    WHERE,
    CLAUSE    : FIELD;
    FROM      : TABLE;
    TABLE_PTR : TABLE_LINK;
    CURSOR    : CURSOR_TYPE;
  begin
    WHAT := F.DOWN_LINK;
    FROM_FIELD := WHAT.ACROSS_LINK;
    FROM := FROM_FIELD.TABLE_LINK;
    WHERE := FROM_FIELD.ACROSS_LINK;
    CLAUSE := WHERE;
    if DATABASE = null or else F.OPCODE /= O_SELECT then
      raise CALL_ERROR;
    elsif FROM.NEXT_LINK /= null or else WHAT.NAME.all /= "*" then
      raise UNIMPLEMENTED_ERROR;
    elsif WHAT.RELATION /= null and then WHAT.RELATION.all /= FROM.NAME.all
        then
      raise FIELD_ERROR;
    end if;
    for I in 1..3 loop
      CLAUSE := CLAUSE.ACROSS_LINK;
      if CLAUSE.FIELD_TYPE /= EMPTY then
        raise UNIMPLEMENTED_ERROR;
      end if;
    end loop;
    TABLE_PTR := FIND_TABLE(FROM.NAME);
    CURSOR.CURRENT_RECORD := TABLE_PTR.RECORDS;
    BUILD_WHERE(CURSOR,WHERE,TABLE_PTR);
    return CURSOR;
  exception
    when CONSTRAINT_ERROR =>
      raise UNIMPLEMENTED_ERROR;
  end EXECUTE;

  procedure SET_DATABASE(DB : in DATABASE_TYPE) is
  begin
    DATABASE := DB;
  end SET_DATABASE;

  function EQUAL_RECORD(CURSOR : in CURSOR_TYPE) return BOOLEAN is
    COMPARE : QUERY_NODE := CURSOR.QUERY;
  begin
    while COMPARE /= null loop
      if not EQUAL(COMPARE.VALUE,CURSOR.CURRENT_RECORD.VALUES(COMPARE.FIELD))
          then
        return FALSE;
      end if;
      COMPARE := COMPARE.NEXT_NODE;
    end loop;
    return TRUE;
  end EQUAL_RECORD;

  procedure NEXT_RECORD(CURSOR : in out CURSOR_TYPE) is
  begin
    if CURSOR.CURRENT_RECORD = null then
      raise DONE_ERROR;
    elsif CURSOR.NEW_QUERY = TRUE then
      CURSOR.NEW_QUERY := FALSE;
    else
      CURSOR.CURRENT_RECORD := CURSOR.CURRENT_RECORD.NEXT_RECORD;
    end if;
    while CURSOR.CURRENT_RECORD /= null loop
      if EQUAL_RECORD(CURSOR) then
        return;
      end if;
      CURSOR.CURRENT_RECORD := CURSOR.CURRENT_RECORD.NEXT_RECORD;
    end loop;
    raise DONE_ERROR;
  end NEXT_RECORD;

  procedure FETCH_RAZOR(CURSOR : in CURSOR_TYPE; FIELD : in FIELD_INDEX) is
  begin
    if CURSOR.CURRENT_RECORD = null then
      raise CALL_ERROR;
    elsif FIELD > CURSOR.CURRENT_RECORD.VALUES'LAST then
      raise FIELD_ERROR;
    end if;
  end FETCH_RAZOR;

  function FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX) return INTEGER is
  begin
    FETCH_RAZOR(CURSOR,FIELD);
    return CURSOR.CURRENT_RECORD.VALUES(FIELD).INTEGER_VALUE;
  exception
    when CONSTRAINT_ERROR =>
      raise TYPE_ERROR;
  end FETCH;

  function FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX) return FLOAT is
  begin
    FETCH_RAZOR(CURSOR,FIELD);
    return CURSOR.CURRENT_RECORD.VALUES(FIELD).FLOAT_VALUE;
  exception
    when CONSTRAINT_ERROR =>
      raise TYPE_ERROR;
  end FETCH;

  function FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX) return STRING is
  begin
    FETCH_RAZOR(CURSOR,FIELD);
    return CURSOR.CURRENT_RECORD.VALUES(FIELD).STRING_VALUE.all;
  exception
    when CONSTRAINT_ERROR =>
      raise TYPE_ERROR;
  end FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  INT    : out INTEGER) is
  begin
    INT := FETCH(CURSOR,FIELD);
  end FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  FLT    : out FLOAT) is
  begin
    FLT := FETCH(CURSOR,FIELD);
  end FETCH;

  procedure FETCH(CURSOR : in  CURSOR_TYPE;
                  FIELD  : in  FIELD_INDEX;
                  STR    : out STRING;
                  LAST   : out NATURAL) is
    S : STRING_LINK;
    L : NATURAL;
  begin
    FETCH_RAZOR(CURSOR,FIELD);
    S := CURSOR.CURRENT_RECORD.VALUES(FIELD).STRING_VALUE;
    if S'LENGTH > STR'LENGTH then
      raise TRUNCATE_ERROR;
    end if;
    L := STR'FIRST + S'LENGTH - 1;
    STR(STR'FIRST..L) := S.all;
    LAST := L;
  exception
    when CONSTRAINT_ERROR =>
      raise TYPE_ERROR;
  end FETCH;

  procedure MAKE_NEW_RECORD(TABLE : in out TABLE_LINK;
                            REC   : out RECORD_LINK) is
    NEW_RECORD : RECORD_LINK := new RECORD_TYPE(TABLE.NUMBER_FIELDS);
  begin
    for I in 1..TABLE.NUMBER_FIELDS loop
      case TABLE.FIELDS(I).DATA_TYPE is
        when INTEGER_FIELD =>
          NEW_RECORD.VALUES(I) := new VALUE_TYPE'(INTEGER_FIELD,0);
        when FLOAT_FIELD =>
          NEW_RECORD.VALUES(I) := new VALUE_TYPE'(FLOAT_FIELD,0.0);
        when STRING_FIELD =>
          NEW_RECORD.VALUES(I) :=
              new VALUE_TYPE'(STRING_FIELD,new STRING'(""));
      end case;
    end loop;
    REC := NEW_RECORD;
  end MAKE_NEW_RECORD;

  procedure INSERT_NEW_RECORD(TABLE : in out TABLE_LINK;
                              REC   : in     RECORD_LINK) is
    LAST_RECORD : RECORD_LINK := TABLE.RECORDS;
  begin
    if LAST_RECORD = null then
      TABLE.RECORDS := REC;
    else
      while LAST_RECORD.NEXT_RECORD /= null loop -- should save last pointer **
        LAST_RECORD := LAST_RECORD.NEXT_RECORD;
      end loop;
      LAST_RECORD.NEXT_RECORD := REC;
    end if;
  end INSERT_NEW_RECORD;

  procedure BUILD_INSERT_LIST(TABLE       : in TABLE_LINK;
                              FIELD_LIST  : in FIELD;
                              INSERT_LIST : in out QUERY_NODE) is
  begin
    case FIELD_LIST.FIELD_TYPE is
      when OPERATOR =>
        if FIELD_LIST.OPCODE /= O_CAT then
          raise SYNTAX_ERROR;
        end if;
        BUILD_INSERT_LIST(TABLE,FIELD_LIST.DOWN_LINK.ACROSS_LINK,INSERT_LIST);
        BUILD_INSERT_LIST(TABLE,FIELD_LIST.DOWN_LINK,INSERT_LIST);
      when UNQUALIFIED_FIELD =>
        INSERT_LIST := new QUERY_NODE_REC'(INSERT_LIST,
            FIND_FIELD(TABLE,FIELD_LIST.NAME),null);
      when others =>
        raise SYNTAX_ERROR;
    end case;
  end BUILD_INSERT_LIST;

  procedure INSERT_VALUES(TABLE    : in TABLE_LINK;
                          REC      : in out RECORD_LINK;
                          INTO     : in out QUERY_NODE;
                          LITERALS : in FIELD) is
    FIELD_NUMBER : FIELD_INDEX;
  begin
    case LITERALS.FIELD_TYPE is
      when OPERATOR =>
        if LITERALS.OPCODE /= O_AND then
          raise SYNTAX_ERROR;
        end if;
        INSERT_VALUES(TABLE,REC,INTO,LITERALS.DOWN_LINK);
        INSERT_VALUES(TABLE,REC,INTO,LITERALS.DOWN_LINK.ACROSS_LINK);
      when INTEGER_LITERAL | FLOAT_LITERAL | STRING_LITERAL =>
        if INTO = null then
          raise SYNTAX_ERROR;
        end if;
        FIELD_NUMBER := INTO.FIELD;
        if LITERALS.FIELD_TYPE /=
            MATCHING_TYPES(TABLE.FIELDS(FIELD_NUMBER).DATA_TYPE) then
          raise UNIMPLEMENTED_ERROR;
        end if;
        REC.VALUES(FIELD_NUMBER) := CREATE_LITERAL_VALUE(LITERALS);
        INTO := INTO.NEXT_NODE;
      when others =>
        raise SYNTAX_ERROR;
      end case;
  end INSERT_VALUES;

  procedure ONLY_ONE_TABLE(T : in TABLE) is
  begin
    if T.NEXT_LINK /= null then
      raise SYNTAX_ERROR;
    end if;
  end ONLY_ONE_TABLE;

  procedure DO_INSERT(F : in FIELD) is
    FIELD_LIST  : FIELD := F.ACROSS_LINK;
    INTO_TABLE  : TABLE := FIELD_LIST.TABLE_LINK;
    TABLE_PTR   : TABLE_LINK;
    VALUE_LIST  : FIELD := F.DOWN_LINK;
    NEW_RECORD  : RECORD_LINK;
    INSERT_LIST : QUERY_NODE;
  begin
    ONLY_ONE_TABLE(INTO_TABLE);
    TABLE_PTR := FIND_TABLE(INTO_TABLE.NAME);
    FIELD_LIST := FIELD_LIST.ACROSS_LINK;
    MAKE_NEW_RECORD(TABLE_PTR,NEW_RECORD);
    if FIELD_LIST = null then
      raise UNIMPLEMENTED_ERROR;
    else
      if VALUE_LIST.FIELD_TYPE = OPERATOR and then
          VALUE_LIST.OPCODE = O_SELECT then
        raise UNIMPLEMENTED_ERROR;
      end if;
      BUILD_INSERT_LIST(TABLE_PTR,FIELD_LIST,INSERT_LIST);
      INSERT_VALUES(TABLE_PTR,NEW_RECORD,INSERT_LIST,VALUE_LIST);
      if INSERT_LIST /= null then
        raise SYNTAX_ERROR;
      end if;
      INSERT_NEW_RECORD(TABLE_PTR,NEW_RECORD);
    end if;
  end DO_INSERT;

  procedure DO_DELETE(F : in FIELD) is
    WHERE     : FIELD := F.DOWN_LINK;
    FROM      : TABLE := WHERE.TABLE_LINK;
    CURSOR    : CURSOR_TYPE;
    TABLE_PTR : TABLE_LINK;
    PREVIOUS  : RECORD_LINK;
  begin
    ONLY_ONE_TABLE(FROM);
    TABLE_PTR := FIND_TABLE(FROM.NAME);
    CURSOR.CURRENT_RECORD := TABLE_PTR.RECORDS;
    BUILD_WHERE(CURSOR,WHERE.ACROSS_LINK,TABLE_PTR);
    while CURSOR.CURRENT_RECORD /= null and then EQUAL_RECORD(CURSOR) loop
      CURSOR.CURRENT_RECORD := CURSOR.CURRENT_RECORD.NEXT_RECORD;
      TABLE_PTR.RECORDS := CURSOR.CURRENT_RECORD;
    end loop;
    PREVIOUS := CURSOR.CURRENT_RECORD;
    if PREVIOUS /= null then
      while PREVIOUS.NEXT_RECORD /= null loop
        CURSOR.CURRENT_RECORD := PREVIOUS.NEXT_RECORD;
        if EQUAL_RECORD(CURSOR) then
          PREVIOUS.NEXT_RECORD := CURSOR.CURRENT_RECORD.NEXT_RECORD;
        else
          PREVIOUS := CURSOR.CURRENT_RECORD;
        end if;
      end loop;
    end if;
  end DO_DELETE;

  procedure BUILD_SET_LIST(SET_LIST : in out QUERY_NODE;
                           SET      : in FIELD;
                           WHAT     : in TABLE_LINK) is
    FIELD_NUMBER : FIELD_INDEX;
    TARGET_TYPE  : DATABASE_FIELD_TYPE;
    LEFT,
    RIGHT        : FIELD;
  begin
    if SET.FIELD_TYPE /= OPERATOR then
      raise SYNTAX_ERROR;
    end if;
    LEFT := SET.DOWN_LINK; RIGHT := LEFT.ACROSS_LINK;
    case SET.OPCODE is
      when O_CAT =>
        BUILD_SET_LIST(SET_LIST,RIGHT,WHAT);
        BUILD_SET_LIST(SET_LIST,LEFT,WHAT);
      when O_EQ =>
        if LEFT.FIELD_TYPE /= UNQUALIFIED_FIELD then
          raise SYNTAX_ERROR;
        end if;
        FIELD_NUMBER := FIND_FIELD(WHAT,LEFT.NAME);
        TARGET_TYPE := WHAT.FIELDS(FIELD_NUMBER).DATA_TYPE;
        if RIGHT.FIELD_TYPE /=
            MATCHING_TYPES(TARGET_TYPE) then
          raise UNIMPLEMENTED_ERROR;
        end if;
        SET_LIST := new QUERY_NODE_REC'(SET_LIST,FIELD_NUMBER,
          CREATE_LITERAL_VALUE(RIGHT));
      when others =>
        raise SYNTAX_ERROR;
    end case;
  end BUILD_SET_LIST;

  procedure DO_UPDATE(F : in FIELD) is
    FROM      : TABLE := F.DOWN_LINK.TABLE_LINK;
    SET       : FIELD := F.DOWN_LINK.ACROSS_LINK;
    WHERE     : FIELD := SET.ACROSS_LINK;
    TABLE_PTR : TABLE_LINK;
    SET_LIST,
    SET_NOW   : QUERY_NODE;
    CURSOR    : CURSOR_TYPE;
  begin
    ONLY_ONE_TABLE(FROM);
    TABLE_PTR := FIND_TABLE(FROM.NAME);
    CURSOR.CURRENT_RECORD := TABLE_PTR.RECORDS;
    BUILD_WHERE(CURSOR,WHERE,TABLE_PTR);
    BUILD_SET_LIST(SET_LIST,SET,TABLE_PTR);
    loop
      NEXT_RECORD(CURSOR);
      SET_NOW := SET_LIST;
      while SET_NOW /= null loop
        CURSOR.CURRENT_RECORD.VALUES(SET_NOW.FIELD) := SET_NOW.VALUE;
        SET_NOW := SET_NOW.NEXT_NODE;
      end loop;
    end loop;
  exception
    when DONE_ERROR =>
      return;
  end DO_UPDATE;

  procedure EXECUTE(F : in FIELD) is
  begin
    case F.OPCODE is
      when O_INSERT =>
        DO_INSERT(F);
      when O_DELETE =>
        DO_DELETE(F);
      when O_UPDATE =>
        DO_UPDATE(F);
      when others =>
        raise SYNTAX_ERROR;
    end case;
  exception
    when CONSTRAINT_ERROR =>
      raise SYNTAX_ERROR;
  end EXECUTE;

  procedure LIST(F : in FIELD) is
  begin
    null;
  end LIST;

end PROGRAM_FUNCTIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--bulkfunc.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_INPUT, TEXT_IO, TEXT_PRINT;
  use TEXT_INPUT, TEXT_IO, TEXT_PRINT;

separate(SQL_DEFINITIONS.SQL_FUNCTIONS)
package body BULK_FUNCTIONS is

  type TABLE_LIST_REC;

  type TABLE_LIST_LINK is access TABLE_LIST_REC;

  type TABLE_LIST_REC is
    record
      NEXT_TABLE : TABLE_LIST_LINK;
      TABLE      : TABLE_LINK;
    end record;

  type FIELD_LINK is access FIELD_TYPE;

  type FIELD_LIST_REC;

  type FIELD_LIST_LINK is access FIELD_LIST_REC;

  type FIELD_LIST_REC is
    record
      NEXT_FIELD : FIELD_LIST_LINK;
      FIELD      : FIELD_LINK;
    end record;

  function CHECK_FIELD_LIST(BUFFER     : BUFFER_TYPE;
                            FIELD_LIST : FIELD_LIST_LINK; -- return -> last one
                            NAME       : FIELD_NAME) return FIELD_LIST_LINK is
    FIELD : FIELD_LIST_LINK := FIELD_LIST;
  begin
    loop
      if NAME.all = FIELD.FIELD.NAME.all then
        CARD_ERROR(BUFFER,"DBLOAD - Duplicate FIELD name");
      end if;
      exit when FIELD.NEXT_FIELD = null;
      FIELD := FIELD.NEXT_FIELD;
    end loop;
    return FIELD;
  end CHECK_FIELD_LIST;

  function CHECK_TABLE_LIST(BUFFER     : BUFFER_TYPE;
                            TABLE_LIST : TABLE_LIST_LINK; -- return -> last one
                            NAME       : TABLE_NAME) return TABLE_LIST_LINK is
    TABLE : TABLE_LIST_LINK := TABLE_LIST;
  begin
    loop
      if NAME.all = TABLE.TABLE.NAME.all then
        CARD_ERROR(BUFFER,"DBLOAD - Duplicate TABLE name");
      end if;
      exit when TABLE.NEXT_TABLE = null;
      TABLE := TABLE.NEXT_TABLE;
    end loop;
    return TABLE;
  end CHECK_TABLE_LIST;

  function COMBINE_FIELDS(TABLE       : TABLE_NAME;
                          FIRST_FIELD : FIELD_LIST_LINK) return TABLE_LINK is
    F : FIELD_LIST_LINK := FIRST_FIELD;
    T : TABLE_LINK;
    C : EXTENDED_FIELD_INDEX := 0;
  begin
    while F /= null loop
      C := C + 1;
      F := F.NEXT_FIELD;
    end loop;
    T := new TABLE_TYPE(C);
    T.NAME := TABLE;
    F := FIRST_FIELD;
    for I in 1..C loop
      T.FIELDS(I) := F.FIELD.all;
      F := F.NEXT_FIELD;
    end loop;
    return T;
  end COMBINE_FIELDS;

  function COMBINE_TABLES(FIRST_TABLE : TABLE_LIST_LINK) return DATABASE_TYPE
      is
    D : DATABASE_TYPE;
    T : TABLE_LIST_LINK := FIRST_TABLE;
    C : EXTENDED_TABLE_INDEX := 0;
  begin
    while T /= null loop
      C := C + 1;
      T := T.NEXT_TABLE;
    end loop;
    D := new TABLE_ARRAY(1..C);
    T := FIRST_TABLE;
    for I in 1..C loop
      D(I) := T.TABLE;
      T := T.NEXT_TABLE;
    end loop;
    return D;
  end COMBINE_TABLES;

  procedure GET_DATA(BUFFER : in out BUFFER_TYPE;
                     IDENT  : in out STRING;
                     LAST   : in out POSITIVE;
                     TABLE  : in out TABLE_LINK) is
    LAST_RECORD  : RECORD_LINK := new RECORD_TYPE(0);
  begin
    TABLE.RECORDS := LAST_RECORD;
    loop
      exit when IDENT(1..LAST) /= "DATA";
      LAST_RECORD.NEXT_RECORD := new RECORD_TYPE(TABLE.NUMBER_FIELDS);
      LAST_RECORD := LAST_RECORD.NEXT_RECORD;
      begin
        for I in 1..TABLE.NUMBER_FIELDS loop
          case TABLE.FIELDS(I).DATA_TYPE is
            when INTEGER_FIELD =>
              LAST_RECORD.VALUES(I) :=
                new VALUE_TYPE'(INTEGER_FIELD,IN_INTEGER(BUFFER));
            when FLOAT_FIELD =>
              LAST_RECORD.VALUES(I) :=
                new VALUE_TYPE'(FLOAT_FIELD,IN_FLOAT(BUFFER));
            when STRING_FIELD =>
              LAST_RECORD.VALUES(I) :=
                new VALUE_TYPE'(STRING_FIELD,IN_STRING(BUFFER));
              if LAST_RECORD.VALUES(I).STRING_VALUE'LENGTH >
                  TABLE.FIELDS(I).SIZE then
                CARD_ERROR(BUFFER,"DBLOAD - STRING longer than declaration");
              end if;
          end case;
        end loop;
      exception
        when END_ERROR =>
          CARD_ERROR(BUFFER,"DBLOAD - end of file before all DATA read");
        when others =>
          CARD_ERROR(BUFFER,"DBLOAD - improper format on data");
      end;
      IN_IDENT(BUFFER,IDENT,LAST);
    end loop;
    TABLE.RECORDS := TABLE.RECORDS.NEXT_RECORD;
  exception
    when END_ERROR =>
      TABLE.RECORDS := TABLE.RECORDS.NEXT_RECORD;
  end GET_DATA;

  procedure GET_FIELDS(BUFFER : in out BUFFER_TYPE;
                       IDENT  : in out STRING;
                       LAST   : in out POSITIVE;
                       FIELD1 : out    FIELD_LIST_LINK) is
    FIELD_LIST : FIELD_LIST_LINK := new FIELD_LIST_REC'(null,
        new FIELD_TYPE'(new FIELD_NAME_STRING'(""),STRING_FIELD,1));
    LAST_FIELD : FIELD_LIST_LINK;
    FLD_NAME   : FIELD_NAME;
    TYPE_FIELD : DATABASE_FIELD_TYPE;
  begin
    loop
      exit when IDENT(1..LAST) /= "FIELD";
      begin
        IN_IDENT(BUFFER,IDENT,LAST);
        FLD_NAME := new FIELD_NAME_STRING'(FIELD_NAME_STRING(IDENT(1..LAST)));
        LAST_FIELD := CHECK_FIELD_LIST(BUFFER,FIELD_LIST,FLD_NAME);
        IN_IDENT(BUFFER,IDENT,LAST);
        TYPE_FIELD := DATABASE_FIELD_TYPE'VALUE(IDENT(1..LAST) & "_FIELD");
        LAST_FIELD.NEXT_FIELD := new FIELD_LIST_REC'(null,
            new FIELD_TYPE'(FLD_NAME,TYPE_FIELD,1));
        LAST_FIELD.NEXT_FIELD.FIELD.SIZE := IN_INTEGER(BUFFER);
      exception
        when END_ERROR =>
          CARD_ERROR(BUFFER,
              "DBLOAD - premature end of file in FIELD description");
        when others =>
          CARD_ERROR(BUFFER,"DBLOAD - invalid field description");
      end;
      IN_IDENT(BUFFER,IDENT,LAST);
    end loop;
    FIELD1 := FIELD_LIST.NEXT_FIELD;
  exception
    when END_ERROR =>
      FIELD1 := FIELD_LIST.NEXT_FIELD;
  end GET_FIELDS;

  function LOAD_DATABASE(FILE_NAME : in STRING) return DATABASE_TYPE is
    BUFFER     : BUFFER_TYPE := MAKE_BUFFER(100);
    IDENT      : STRING(1..100);
    LAST       : NATURAL;
    TABLE_LIST : TABLE_LIST_LINK := new TABLE_LIST_REC'(null,
        new TABLE_TYPE'(0,new TABLE_NAME_STRING'(""),null,
        (1..0 => FIELD_TYPE'(new FIELD_NAME_STRING'(""),STRING_FIELD,1))));
    FIELD_LIST : FIELD_LIST_LINK;
    LAST_TABLE : TABLE_LIST_LINK;
    TBL_NAME   : TABLE_NAME;
  begin
    OPEN_INPUT(BUFFER,IN_FILE,FILE_NAME);
    IN_IDENT(BUFFER,IDENT,LAST);
    while not END_OF_FILE(BUFFER) loop
      exit when IDENT(1..LAST) = "END"; -- exceptions are not propagating right
      if IDENT(1..LAST) /= "TABLE" then
        CARD_ERROR(BUFFER,"DBLOAD - TABLE card expected, not found");
      end if;
      begin
        IN_IDENT(BUFFER,IDENT,LAST);
      exception
        when others =>
          CARD_ERROR(BUFFER,"DBLOAD - invalid TABLE card");
      end;
      TBL_NAME := new TABLE_NAME_STRING'(TABLE_NAME_STRING(IDENT(1..LAST)));
      LAST_TABLE := CHECK_TABLE_LIST(BUFFER,TABLE_LIST,TBL_NAME);
      IN_IDENT(BUFFER,IDENT,LAST);
      GET_FIELDS(BUFFER,IDENT,LAST,FIELD_LIST);
      LAST_TABLE.NEXT_TABLE := new TABLE_LIST_REC'(null,
        COMBINE_FIELDS(TBL_NAME,FIELD_LIST));
      GET_DATA(BUFFER,IDENT,LAST,LAST_TABLE.NEXT_TABLE.TABLE);
    end loop;
    CLOSE_INPUT(BUFFER);
    return COMBINE_TABLES(TABLE_LIST.NEXT_TABLE);
  end LOAD_DATABASE;

  procedure SAVE_DATA(FILE  : in FILE_TYPE;
                      TABLE : in TABLE_LINK;
                      REC   : in RECORD_LINK) is
  begin
    PRINT(FILE,"DATA");
    for I in 1..TABLE.NUMBER_FIELDS loop
      PRINT(FILE," ");
      case TABLE.FIELDS(I).DATA_TYPE is
        when INTEGER_FIELD =>
          PRINT(FILE,REC.VALUES(I).INTEGER_VALUE,NO_BREAK);
        when FLOAT_FIELD =>
          PRINT(FILE,REC.VALUES(I).FLOAT_VALUE,NO_BREAK);
        when STRING_FIELD =>
          PRINT(FILE,"""" & REC.VALUES(I).STRING_VALUE.all & """",NO_BREAK);
      end case;
    end loop;
    PRINT_LINE(FILE);
  end SAVE_DATA;

  procedure SAVE_FIELDS(FILE : in FILE_TYPE; TABLE : in TABLE_LINK) is
    FIELD : FIELD_TYPE;
  begin
    for I in 1..TABLE.NUMBER_FIELDS loop
      FIELD := TABLE.FIELDS(I);
      PRINT(FILE,"FIELD " & STRING(FIELD.NAME.all) & " ");
      case FIELD.DATA_TYPE is
        when INTEGER_FIELD =>
          PRINT(FILE,"INTEGER ",NO_BREAK);
        when FLOAT_FIELD =>
          PRINT(FILE,"FLOAT ",NO_BREAK);
        when STRING_FIELD =>
          PRINT(FILE,"STRING ",NO_BREAK);
      end case;
      PRINT(FILE,FIELD.SIZE); PRINT_LINE(FILE);
    end loop;
  end SAVE_FIELDS;

  procedure SAVE_DATABASE(FILE_NAME : in STRING; DATABASE : in DATABASE_TYPE)
      is
    FILE  : FILE_TYPE;
    L     : LINE_TYPE;
    TABLE : TABLE_LINK;
    REC   : RECORD_LINK;
  begin
    CREATE(FILE,OUT_FILE,FILE_NAME); CREATE_LINE(L,79); SET_LINE(L);
    for I in 1..DATABASE'LAST loop
      BLANK_LINE(FILE);
      TABLE := DATABASE(I);
      PRINT(FILE,"TABLE " & STRING(TABLE.NAME.all));
      PRINT_LINE(FILE); BLANK_LINE(FILE);
      SAVE_FIELDS(FILE,TABLE);
      REC := TABLE.RECORDS;
      if REC /= null then
        BLANK_LINE(FILE);
        while REC /= null loop
          SAVE_DATA(FILE,TABLE,REC);
          REC := REC.NEXT_RECORD;
        end loop;
      end if;
    end loop;
    BLANK_LINE(FILE); PRINT(FILE,"END"); PRINT_LINE(FILE);
    PRINT(FILE,"END"); PRINT_LINE(FILE);
    CLOSE(FILE);
  end SAVE_DATABASE;

end BULK_FUNCTIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--show.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with TEXT_PRINT;
  use TEXT_PRINT;

separate(SQL_DEFINITIONS.SQL_FUNCTIONS)
package body SHOW_PACKAGE is

  type TABLE_LIST_REC;

  type TABLE_LIST is access TABLE_LIST_REC;

  type TABLE_LIST_REC is
    record
      NAME,
      PRINT        : TABLE_NAME;
      VERSION_LINK,
      NAME_LINK    : TABLE_LIST;
    end record;

  type PRECEDENCE_TYPE is range 1..10; -- SQL, not Ada, operator precedence

  type CLAUSE_NAME_TYPE is new STRING(1..7);

  procedure SHOWR(F : in FIELD);

  INDENT        : INTEGER;
  TABLE_TABLE   : TABLE_LIST;
  DOING_SET     : BOOLEAN := FALSE;
  INITIAL_TABLE : constant TABLE_LIST := new TABLE_LIST_REC'(
                                  new TABLE_NAME_STRING'(""),null,null,null);

  PRECEDENCE : constant array(OPERATOR_TYPE) of PRECEDENCE_TYPE := (
    O_SELECT | O_INSERT | O_DELETE | O_UPDATE | O_SUM | O_AVG | O_MAX |
        O_MIN | O_COUNT | O_DESC | O_CAT                                => 10,
    O_ABS                                                               => 9,
    O_POWER                                                             => 8,
    O_TIMES | O_DIV | O_MOD | O_REM                                     => 7,
    O_UNARY_PLUS | O_UNARY_MINUS                                        => 6,
    O_PLUS | O_MINUS                                                    => 5,
    O_EQ | O_NE | O_LT | O_LE | O_GT | O_GE | O_LIKE | O_IN | O_EXISTS  => 4,
    O_NOT                                                               => 3,
    O_AND                                                               => 2,
    O_OR | O_XOR                                                        => 1);

  OPERATOR_NAME : constant array(OPERATOR_TYPE) of STRING_LINK := (
    new STRING'("SELECT"), new STRING'("INSERT"), new STRING'("DELETE"),
    new STRING'("UPDATE"), new STRING'("LIKE"),   new STRING'("SUM"),
    new STRING'("AVG"),    new STRING'("MAX"),    new STRING'("MIN"),
    new STRING'("COUNT"),  new STRING'("IN"),     new STRING'("EXISTS"),
    new STRING'("DESC"),   new STRING'("AND"),    new STRING'("OR"),
    new STRING'("XOR"),    new STRING'("="),      new STRING'("/="),
    new STRING'("<"),      new STRING'("<="),     new STRING'(">"),
    new STRING'(">="),     new STRING'("+"),      new STRING'("-"),
    new STRING'(","),      new STRING'("+"),      new STRING'("-"),
    new STRING'("*"),      new STRING'("/"),      new STRING'("MOD"),
    new STRING'("REM"),    new STRING'("**"),    new STRING'("ABS"),
    new STRING'("NOT") );

  CLAUSE_NAME : constant array(1..4) of CLAUSE_NAME_TYPE :=
    ("WHERE  ", "GROUP  ", "HAVING ", "ORDER  ");

  HAS_BY : constant array(1..4) of BOOLEAN := (FALSE, TRUE, FALSE, TRUE);

  SIX_BLANKS : constant STRING := "      ";

  procedure ENTER_NEW_TABLE(T : TABLE_NAME) is
    NAME_ENTRY    : TABLE_LIST := TABLE_TABLE;
    VERSION_ENTRY : TABLE_LIST;
  begin
    loop
      if NAME_ENTRY.NAME.all = T.all then
        VERSION_ENTRY := NAME_ENTRY;
        loop
          if VERSION_ENTRY.NAME = T then
            return;
          end if;
          exit when VERSION_ENTRY.VERSION_LINK = null;
          VERSION_ENTRY := VERSION_ENTRY.VERSION_LINK;
        end loop;
        VERSION_ENTRY.VERSION_LINK := new TABLE_LIST_REC'(T,T,null,null);
        return;
      end if;
      exit when NAME_ENTRY.NAME_LINK = null;
      NAME_ENTRY := NAME_ENTRY.NAME_LINK;
    end loop;
    NAME_ENTRY.NAME_LINK := new TABLE_LIST_REC'(T,T,null,null);
  end ENTER_NEW_TABLE;

  procedure CREATE_TABLE_TABLE(F : in FIELD) is
    G : FIELD;
    T : TABLE;
  begin
    case F.FIELD_TYPE is
      when OPERATOR =>
        G := F.DOWN_LINK;
        while G /= null loop
          CREATE_TABLE_TABLE(G);
          G := G.ACROSS_LINK;
        end loop;
      when QUALIFIED_FIELD =>
        ENTER_NEW_TABLE(F.RELATION);
      when FROM_LIST =>
        T := F.TABLE_LINK;
        while T /= null loop
          ENTER_NEW_TABLE(T.NAME);
          T := T.NEXT_LINK;
        end loop;
      when others =>
        null;
    end case;
  end CREATE_TABLE_TABLE;

  procedure FINALIZE_TABLE_TABLE is
    NAME_ENTRY : TABLE_LIST := TABLE_TABLE;
    VERSION_ENTRY,NEXT_NAME,NEXT_VERSION : TABLE_LIST;
    VERSION_NUMBER,NAME_LENGTH : INTEGER;
  begin
    while NAME_ENTRY /= null loop
      if NAME_ENTRY.VERSION_LINK /= null then
        VERSION_NUMBER := 1;
        VERSION_ENTRY := NAME_ENTRY;
        NAME_LENGTH := VERSION_ENTRY.NAME'LENGTH;
        while VERSION_ENTRY /= null loop
          VERSION_ENTRY.PRINT := new TABLE_NAME_STRING'(
            TABLE_NAME_STRING(
              STRING(VERSION_ENTRY.NAME.all) &
                INTEGER'IMAGE(VERSION_NUMBER) & ")" ) );
          VERSION_ENTRY.PRINT(NAME_LENGTH+1) := '(';
          VERSION_NUMBER := VERSION_NUMBER + 1;
          NEXT_NAME := NAME_ENTRY.NAME_LINK;
          NEXT_VERSION := VERSION_ENTRY.VERSION_LINK;
          NAME_ENTRY.NAME_LINK := VERSION_ENTRY;
          VERSION_ENTRY.NAME_LINK := NEXT_NAME;
          NAME_ENTRY := VERSION_ENTRY;
          VERSION_ENTRY := NEXT_VERSION;
        end loop;
      end if;
      NAME_ENTRY := NAME_ENTRY.NAME_LINK;
    end loop;
  end FINALIZE_TABLE_TABLE;

  procedure SHOW_TABLE_NAME(NAME : in TABLE_NAME) is
    T : TABLE_LIST := TABLE_TABLE;
  begin
    loop
      if NAME = T.NAME then
        PRINT(STRING(T.PRINT.all),NO_BREAK);
        return;
      end if;
      T := T.NAME_LINK;
    end loop;
  end SHOW_TABLE_NAME;

  procedure SHOW_SELECT(F : in FIELD) is
    CLAUSE : FIELD;
    T      : TABLE;
  begin
    INDENT := INDENT + 7;
    if INDENT > 0 then
      SET_INDENT(INDENT-1); PRINT_LINE; PRINT("("); SET_INDENT(INDENT);
    else
      SET_INDENT(INDENT); PRINT_LINE;
    end if;
    PRINT("SELECT "); CLAUSE := F.DOWN_LINK; SHOWR(CLAUSE);
    CLAUSE := CLAUSE.ACROSS_LINK; T := CLAUSE.TABLE_LINK;
    if T /= null then
      PRINT_LINE; PRINT("FROM   ");
      loop
        SHOW_TABLE_NAME(T.NAME); T := T.NEXT_LINK;
        exit when T = null;
        PRINT(", ");
      end loop;
    end if;
    for I in 1..4 loop
      CLAUSE := CLAUSE.ACROSS_LINK;
      if CLAUSE.FIELD_TYPE /= EMPTY then
        PRINT_LINE; PRINT(STRING(CLAUSE_NAME(I)));
        if HAS_BY(I) then
          PRINT("BY ");
        end if;
        SHOWR(CLAUSE);
      end if;
    end loop;
    INDENT := INDENT - 7;
    if INDENT >= 0 then
      PRINT(")"); SET_INDENT(INDENT);
    end if;
  end SHOW_SELECT;

  procedure START_STATEMENT is
  begin
    INDENT := INDENT + 7; SET_INDENT(INDENT); PRINT_LINE;
  end START_STATEMENT;

  procedure SHOW_INSERT(F : in FIELD) is
    CLAUSE : FIELD;
  begin
    START_STATEMENT; PRINT("INSERT INTO ");
    CLAUSE := F.ACROSS_LINK;
    SHOW_TABLE_NAME(CLAUSE.TABLE_LINK.NAME);
    if CLAUSE.ACROSS_LINK /= null then
      PRINT(" ( "); SHOWR(CLAUSE.ACROSS_LINK); PRINT(" )");
    end if;
    CLAUSE := F.DOWN_LINK;
    if CLAUSE.FIELD_TYPE = OPERATOR and then CLAUSE.OPCODE = O_SELECT then
      SHOW_SELECT(CLAUSE);
    else
      START_STATEMENT;
      PRINT("VALUES ("); SHOWR(CLAUSE); PRINT(")");
      INDENT := INDENT - 7; SET_INDENT(INDENT);
    end if;
    INDENT := INDENT - 7;
  end SHOW_INSERT;

  procedure SHOW_WHERE(F : in FIELD) is
  begin
    if F.FIELD_TYPE /= EMPTY then
      PRINT_LINE; PRINT("WHERE  "); SHOWR(F);
    end if;
  end SHOW_WHERE;

  procedure SHOW_DELETE(F : in FIELD) is
    CLAUSE : FIELD;
  begin
    START_STATEMENT; PRINT("DELETE");
    CLAUSE := F.DOWN_LINK;
    if CLAUSE.TABLE_LINK /= null then
      PRINT_LINE; PRINT("FROM   "); SHOW_TABLE_NAME(CLAUSE.TABLE_LINK.NAME);
    end if;
    SHOW_WHERE(CLAUSE.ACROSS_LINK);
    INDENT := INDENT - 7;
  end SHOW_DELETE;

  procedure SHOW_UPDATE(F : in FIELD) is
    CLAUSE : FIELD;
  begin
    START_STATEMENT; PRINT("UPDATE ");
    CLAUSE := F.DOWN_LINK;
    if CLAUSE.TABLE_LINK /= null then
      SHOW_TABLE_NAME(CLAUSE.TABLE_LINK.NAME);
    end if;
    PRINT_LINE; PRINT("SET    "); INDENT := INDENT + 7; SET_INDENT(INDENT);
    CLAUSE := CLAUSE.ACROSS_LINK;
    DOING_SET := TRUE; SHOWR(CLAUSE); DOING_SET := FALSE;
    INDENT := INDENT - 7; SET_INDENT(INDENT);
    SHOW_WHERE(CLAUSE.ACROSS_LINK);
    INDENT := INDENT - 7;
  end SHOW_UPDATE;

  procedure SHOW_PRECEDENCE(UPPER_PRECEDENCE : in PRECEDENCE_TYPE;
                            OPERAND          : in FIELD) is
  begin
    if OPERAND.FIELD_TYPE = OPERATOR and then
        PRECEDENCE(OPERAND.OPCODE) < UPPER_PRECEDENCE and then
        OPERAND.DOWN_LINK.ACROSS_LINK /= null then
      PRINT("( "); SHOWR(OPERAND); PRINT(" )");
    else
      SHOWR(OPERAND);
    end if;
  end SHOW_PRECEDENCE;

  procedure SHOW_MARGIN(F : in FIELD) is
  begin
    SHOW_PRECEDENCE(PRECEDENCE(F.OPCODE),F.DOWN_LINK); PRINT_LINE;
    PRINT(OPERATOR_NAME(F.OPCODE).all &
        SIX_BLANKS(OPERATOR_NAME(F.OPCODE)'LENGTH..6));
    SHOW_PRECEDENCE(PRECEDENCE(F.OPCODE),F.DOWN_LINK.ACROSS_LINK);
  end SHOW_MARGIN;

  procedure SHOW_LIST(F : in FIELD) is
  begin
    SHOWR(F.DOWN_LINK); PRINT(", ");
    if DOING_SET then
      PRINT_LINE;
    end if;
    SHOWR(F.DOWN_LINK.ACROSS_LINK);
  end SHOW_LIST;

  procedure SHOW_OPERATOR(F : in FIELD) is
  begin
    case F.OPCODE is
      when O_SELECT =>
        SHOW_SELECT(F);
      when O_INSERT =>
        SHOW_INSERT(F);
      when O_DELETE =>
        SHOW_DELETE(F);
      when O_UPDATE =>
        SHOW_UPDATE(F);
      when O_SUM | O_AVG | O_MAX | O_MIN | O_COUNT =>
        PRINT(OPERATOR_NAME(F.OPCODE).all & "("); SHOWR(F.DOWN_LINK);
        PRINT(")");
      when O_DESC =>
        SHOWR(F.DOWN_LINK); PRINT(" DESC");
      when O_IN =>
        SHOW_PRECEDENCE(PRECEDENCE(O_IN),F.DOWN_LINK); PRINT(" IN ");
        if F.DOWN_LINK.ACROSS_LINK.FIELD_TYPE /= OPERATOR or else
             F.DOWN_LINK.ACROSS_LINK.OPCODE /= O_SELECT then
          PRINT("( "); SHOWR(F.DOWN_LINK.ACROSS_LINK); PRINT(" )");
        else
          SHOWR(F.DOWN_LINK.ACROSS_LINK);
        end if;
      when O_LIKE | O_EQ | O_NE | O_LT | O_LE | O_GT | O_GE | O_PLUS |
            O_MINUS | O_TIMES | O_DIV | O_MOD | O_REM | O_POWER =>
        SHOW_PRECEDENCE(PRECEDENCE(F.OPCODE),F.DOWN_LINK);
        PRINT(" " & OPERATOR_NAME(F.OPCODE).all & " ");
        SHOW_PRECEDENCE(PRECEDENCE(F.OPCODE),F.DOWN_LINK.ACROSS_LINK);
      when O_EXISTS | O_UNARY_PLUS | O_UNARY_MINUS | O_ABS | O_NOT =>
        PRINT(OPERATOR_NAME(F.OPCODE).all & " ");
        SHOW_PRECEDENCE(PRECEDENCE(F.OPCODE),F.DOWN_LINK);
      when O_AND | O_OR =>
        if F.DOWN_LINK.FIELD_TYPE = OPERATOR and then
            F.DOWN_LINK.ACROSS_LINK.FIELD_TYPE = OPERATOR then
          SHOW_MARGIN(F);
        else
          SHOW_LIST(F);
        end if;
      when O_XOR =>
        SHOW_MARGIN(F);
      when O_CAT =>
        SHOW_LIST(F);
    end case;
  end SHOW_OPERATOR;

  procedure SHOWR(F : in FIELD) is
    T : TABLE_LIST;
  begin
    case F.FIELD_TYPE is
      when OPERATOR =>
        SHOW_OPERATOR(F);
      when INTEGER_LITERAL =>
        PRINT(F.INTEGER_VALUE);
      when STRING_LITERAL =>
        PRINT("'" & F.STRING_VALUE.all & "'");
      when FLOAT_LITERAL =>
        PRINT(F.FLOAT_VALUE);
      when QUALIFIED_FIELD =>
        SHOW_TABLE_NAME(F.RELATION);
        PRINT("." & STRING(F.NAME.all));
      when UNQUALIFIED_FIELD =>
        PRINT(STRING(F.NAME.all));
      when FROM_LIST | EMPTY =>
        null;
    end case;
  end SHOWR;

  procedure SHOW(F : in FIELD) is
  begin
    INDENT := -7;
    SET_CONTINUATION_INDENT(7);
    BLANK_LINE;
    INITIAL_TABLE.NAME_LINK := null;
    INITIAL_TABLE.VERSION_LINK := null;
    TABLE_TABLE := INITIAL_TABLE;
    CREATE_TABLE_TABLE(F);
    if F.ACROSS_LINK /= null then
      CREATE_TABLE_TABLE(F.ACROSS_LINK);
    end if;
    FINALIZE_TABLE_TABLE;
    SHOWR(F);
    PRINT_LINE;
  end SHOW;

end SHOW_PACKAGE;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--main.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DATE_DATABASE, SQL_OPERATIONS, TEXT_IO, TEXT_PRINT;
  use DATE_DATABASE, SQL_OPERATIONS, TEXT_IO, TEXT_PRINT;

procedure MAIN is

  subtype FIELD is SQL_OPERATIONS.FIELD;

  function COUNT(X : STAR_TYPE) return FIELD renames SQL_OPERATIONS.COUNT;
  function COUNT(F : FIELD)     return FIELD renames SQL_OPERATIONS.COUNT;

  A : FIELD;
  L : LINE_TYPE;
  D : DATABASE_TYPE;

  procedure SHOW_ACCOUNTS(QUERY : FIELD) is
    CURSOR      : CURSOR_TYPE;
    APN         : STRING(1..9);
    EN_TRY      : INTEGER;
    DATE        : STRING(1..6);
    DESCRIPTION : STRING(1..10);
    TYP         : STRING(1..6);
    AMOUNT      : FLOAT;
    BALANCE     : FLOAT;
    L           : NATURAL;

    package INT_IO is new INTEGER_IO(INTEGER);
    package FLT_IO is new FLOAT_IO(FLOAT);
      use INT_IO, FLT_IO;

  begin
    CURSOR := EXECUTE(QUERY);
    NEW_LINE;
    loop
      NEXT_RECORD(CURSOR);
      DATE        := "      ";
      DESCRIPTION := "          ";
      TYP         := "      ";
      APN := FETCH(CURSOR,1);
      EN_TRY := FETCH(CURSOR,2);
      FETCH(CURSOR,3,DATE,L);
      FETCH(CURSOR,4,DESCRIPTION,L);
      FETCH(CURSOR,5,TYP,L);
      AMOUNT := FETCH(CURSOR,6);
      FETCH(CURSOR,7,BALANCE);
      PUT(APN);
      PUT(EN_TRY,4);
      PUT("  " & DATE & "  " & DESCRIPTION & "  " & TYP);
      PUT(AMOUNT,5,2,0);
      PUT(BALANCE,5,2,0);
      NEW_LINE;
    end loop;
  exception
    when DONE_ERROR =>
      null;
  end SHOW_ACCOUNTS;

begin

  CREATE_LINE(L,79); SET_LINE(L); D := LOAD_DATABASE("DATE.DAT");
  SET_DATABASE(D);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(APN,"93-281-24") );

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(EN_TRY,7) );

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(TYP,"CHARGE")
       AND      EQ(AMOUNT,120.00) );

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := DELETE (
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(TYP,"CHARGE") );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := DELETE (
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(APN,"93-281-24")
       AND      EQ(AMOUNT,120.00) );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := UPDATE ( PARCEL_ACCOUNTS,
       SET   => EQ(DESCRIPTION,"BIG BUCKS"),
       WHERE => EQ(AMOUNT,240.00) );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := UPDATE ( PARCEL_ACCOUNTS,
       SET   => EQ(DESCRIPTION,"DUES82 TOO") &
                EQ(BALANCE,0.00),
       WHERE => EQ(APN,"92-291-44")
       AND      EQ(DATE,"821212") );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := UPDATE ( PARCEL_ACCOUNTS,
       SET   => EQ(DESCRIPTION,"OOPS") );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := DELETE ( PARCEL_ACCOUNTS );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := INSERT_INTO ( PARCEL_ACCOUNTS ( APN ),
              VALUES ( "55-555-55" ) );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := INSERT_INTO ( PARCEL_ACCOUNTS ( EN_TRY & DATE & APN ),
              VALUES => ( 99 and "850411" and "66-666-66" ) );

  SHOW(A);

  EXECUTE(A);

  A := SELEC  ( '*',
       FROM  => PARCEL_ACCOUNTS);

  SHOW(A);

  SHOW_ACCOUNTS(A);

  A := SELEC  ( '*',      -- Note use of '*' for SELECT *
       FROM  => CELLAR ); -- Also, SELECT is an Ada reserved word

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => CELLAR,
       WHERE => EQ(WINE,"Chardonnay") ); -- Note EQ instead of =

  SHOW(A);

  A := SELEC  ( BIN & PRODUCER & READY & BOTTLES, -- Note & instead of ,
       FROM  => CELLAR,
       WHERE => EQ(WINE,"Chardonnay") ); -- also note " instead of '

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => CELLAR,
       WHERE => EQ(BIN,3) );

  SHOW(A);

  A := SELEC  ( CODE,
       FROM  => CITIES,
       WHERE => EQ(CITY,"San Francisco") );

  SHOW(A);

  A := SELEC  ( CODE,
       FROM  => CITIES,
       WHERE => EQ(CITY,"Chicago") );

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => FLIGHTS,
       WHERE => EQ(FROM_CODE,"SFO")  -- ultimately, SFO and ORD will be
       AND      EQ(TO_CODE,"ORD") ); -- values of an enumeration type

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => FLIGHTS,
       WHERE => EQ(FROM_CODE,
                   SELEC  ( CODE,
                   FROM  => CITIES,
                   WHERE => EQ(CITY,"San Francisco") ) ) -- note SELECT (
       AND      EQ(TO_CODE,                              -- instead of ( SELECT
                   SELEC  ( CODE,
                   FROM  => CITIES,
                   WHERE => EQ(CITY,"Chicago") ) ) );

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => FLIGHTS,
       WHERE => EQ(FROM_CODE,
                   SELEC  ( CODE,
                   FROM  => CITIES,
                   WHERE => EQ(CITY,"San Francisco") ) )
       AND      EQ(TO_CODE,
                   SELEC  ( CODE,
                   FROM  => CITIES,
                   WHERE => EQ(CITY,"Chicago") ) ),
       ORDER => DEP_TIME );                  -- note ORDER instead of ORDER BY

  SHOW(A);

  A := SELEC  ( OWNER,
       FROM  => PARCELS,
       WHERE => EQ(APN,"93-282-55") );

  SHOW(A);

  A := SELEC  ( AMOUNT,
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(APN,"93-282-55")
       AND      EQ(DESCRIPTION,"PENALTY81")
       AND      EQ(TYP,"CHARGE") );    -- Date uses TYPE, an Ada reserved word

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => OWNERS,
       WHERE => LIKE(ADDRESS,"%BERKELEY%") );

  SHOW(A);

  A := SELEC  ( EN_TRY + 1,     -- date uses ENTRY, an Ada reserved word
       FROM  => LAST_ENTRIES,
       WHERE => EQ(ACCOUNT,"GENERAL") );

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => GENERAL_LEDGER,
       WHERE => EQ(PARTY,"ROAD FIXERS, INC.")
       AND      EQ(TYP,"CHARGE") );

  SHOW(A);

  A := SELEC  ( SUM(AMOUNT),
       FROM  => GENERAL_LEDGER,
       WHERE => EQ(PARTY,"ROAD FIXERS, INC.")
       AND      EQ(TYP,"CHARGE") );

  SHOW(A);

  A := SELEC  ( COUNT('*'),
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(APN,"93-282-55")
       AND      EQ(TYP,"CREDIT")
       AND      DATE > "811231"
       AND      DATE < "830101" );

  SHOW(A);

  A := SELEC  ( MAX(DATE),
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(APN,"93-282-55")
       AND      EQ(TYP,"CREDIT") );

  SHOW(A);

  A := SELEC  ( '*',
       FROM  => OWNERS,
       WHERE => EQ(OWNER,
                   SELEC  ( OWNER,
                   FROM  => PARCELS,
                   WHERE => EQ(APN,"93-282-55") ) ) );

  SHOW(A);

  A := SELEC  ( APN,
       FROM  => PARCELS,
       WHERE => EQ(OWNER,"JOHN MINSKI") );

  SHOW(A);

  A := SELEC  ( SUM(AMOUNT),
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(TYP,"CREDIT")
       AND      IS_IN(APN,"93-282-50" or "93-282-51" or "93-282-54" or
                          "93-282-58") ); -- Ada in may not be overloaded
                                          -- note or instead of ,

  SHOW(A);

  A := SELEC  ( SUM(AMOUNT),
       FROM  => PARCEL_ACCOUNTS,
       WHERE => EQ(TYP,"CREDIT")
       AND      IS_IN(APN,
                      SELEC  ( APN,
                      FROM  => PARCELS,
                      WHERE => EQ(OWNER,"JOHN MINSKI") ) ) );

  SHOW(A);

  A := SELEC  ( SAN & EXPLANATION & APN,
       FROM  => SPECIAL_ASSESSMENTS & PARCELS,          -- note & instead of ,
       WHERE => EQ(SPECIAL_ASSESSMENTS.ROAD,PARCELS.ROAD) );

  SHOW(A);

  A := SELEC  ( PARCELS.APN & OWNERS.OWNER & OWNERS.ADDRESS & OWNERS.PHONE,
       FROM  => PARCELS & OWNERS,
       WHERE => EQ(PARCELS.IMPROVED,"Y")        -- should be some BOOLEAN type
       AND      EQ(PARCELS.OWNER,OWNERS.OWNER),
       ORDER => OWNERS.OWNER & PARCELS.APN ); -- note & instead of ,

  SHOW(A);

  A := SELEC  ( PARCELS.APN & OWNERS.OWNER & OWNERS.ADDRESS & OWNERS.PHONE,
       FROM  => PARCELS & OWNERS,
       WHERE => EQ(PARCELS.IMPROVED,"Y")        -- should be some BOOLEAN type
       AND      EQ(PARCELS.OWNER,OWNERS.OWNER),
       ORDER => DESC(OWNERS.OWNER) & PARCELS.APN ); -- note DESC( )

  SHOW(A);

  A := SELEC  ( APN & OWNER,
       FROM  => PARCELS,
       WHERE => EXISTS
               (SELEC  ( '*',
                FROM  => PARCEL_ACCOUNTS,
                WHERE => EQ(APN,PARCELS.APN)
                AND      EQ(DESCRIPTION,"DUES82")
                AND      EQ(TYP,"CREDIT") ) ) );

  SHOW(A);

  A := SELEC  ( APN & OWNER,
       FROM  => PARCELS,
       WHERE => NOT EXISTS
               (SELEC  ( '*',
                FROM  => PARCEL_ACCOUNTS,
                WHERE => EQ(APN,PARCELS.APN)
                AND      EQ(DESCRIPTION,"DUES82")
                AND      EQ(TYP,"CREDIT") ) ) );

  SHOW(A);

  A := SELEC  ( PARTY & SUM(AMOUNT),
       FROM  => GENERAL_LEDGER,
       WHERE => EQ(TYP,"CHARGE"),
       GROUP => PARTY );                -- note GROUP instead of GROUP BY

  SHOW(A);

  A := SELEC   ( OWNER,
       FROM   => PARCELS,
       GROUP  => OWNER,
       HAVING => COUNT('*') > 1 );

  SHOW(A);

  A := SELEC   ( PARCELS.OWNER & SUM(PARCEL_ACCOUNTS.AMOUNT),
       FROM   => PARCELS & PARCEL_ACCOUNTS,
       WHERE  => EQ(PARCELS.APN,PARCEL_ACCOUNTS.APN)
       AND       EQ(PARCEL_ACCOUNTS.TYP,"CREDIT")
       AND       LIKE(PARCEL_ACCOUNTS.DATE,"82%"),
       GROUP  => PARCELS.OWNER,
       HAVING => SUM(PARCEL_ACCOUNTS.AMOUNT) > 500,
       ORDER  => PARCELS.OWNER );

  SHOW(A);

  A := SELEC  ( APN,
       FROM  => PARCELS,
       WHERE => BALANCE < 0 );

  SHOW(A);

  A := SELEC  ( OWNER & PHONE,
       FROM  => OWNERS,
       WHERE => IS_IN(OWNER,
                      SELEC  ( OWNER,
                      FROM  => PARCELS,
                      WHERE => BALANCE < 0 ) ) );

  SHOW(A);

  A := SELEC  ( AVG(AMOUNT),
       FROM  => GENERAL_LEDGER,
       WHERE => LIKE(DATE,"82%")
       AND      EQ(TYP,"CREDIT") );

  SHOW(A);

  A := SELEC  ( PARCELS.APN & PARCELS.ROAD & PARCELS.OWNER &
                PARCEL_ACCOUNTS.DATE & PARCEL_ACCOUNTS.AMOUNT &
                PARCEL_ACCOUNTS.BALANCE,
       FROM  => PARCELS & PARCEL_ACCOUNTS,
       WHERE => EQ(PARCELS.APN,PARCEL_ACCOUNTS.APN)
       AND      EQ(PARCELS.LAST_ENTRY,PARCEL_ACCOUNTS.EN_TRY),
       ORDER => PARCELS.APN );

  SHOW(A);

  A := SELEC  ( APN & OWNER,
       FROM  => PARCELS,
       WHERE => EXISTS
               (SELEC  ( '*',
                FROM  => PARCEL_ACCOUNTS,
                WHERE => EQ(APN,PARCELS.APN)
                AND      EQ(TYP,"CREDIT")
                AND      AMOUNT > 499.99 ) ) );

  SHOW(A);

  A := SELEC   ( APN,
       FROM   => PARCEL_ACCOUNTS,
       WHERE  => EQ(TYP,"CHARGE")
       AND       DATE > "801231",
       GROUP  => APN,
       HAVING => COUNT('*') > 5,
       ORDER  => APN );

  SHOW(A);

  -- This completes Chapter 4 of Date's book, which contains the exposition of
  -- SQL.  Later chapters do not include any new SQL constructs, so we end our
  -- examples here.

end MAIN;