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

Text File | 1988-05-03 | 50.6 KB | 1,835 lines

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

package TOKEN_INPUT is

  type INPUT_STREAM is private;

  package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
    use INTEGER_IO;

  function CREATE_STREAM(CARD_LENGTH : POSITIVE) return INPUT_STREAM;

  procedure SET_STREAM(STREAM : INPUT_STREAM);

  procedure OPEN_INPUT(STREAM : INPUT_STREAM;
                       NAME   : STRING);

  procedure OPEN_INPUT(NAME : STRING);

  procedure CLOSE_INPUT(STREAM : INPUT_STREAM);

  procedure CLOSE_INPUT;

  procedure GET_STRING(STREAM : in  INPUT_STREAM;
                       STR    : out STRING;
                       LAST   : out NATURAL);

  procedure GET_STRING(STR  : out STRING;
                       LAST : out NATURAL);

  function GET_INTEGER(STREAM : INPUT_STREAM) return INTEGER;

  function GET_INTEGER return INTEGER;

  procedure GOBBLE(STREAM : INPUT_STREAM;
                   STR    : STRING);

  procedure GOBBLE(STR : STRING);

private

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

  type INPUT_STREAM is access INPUT_RECORD;

end TOKEN_INPUT;

package body TOKEN_INPUT is

  DEFAULT_STREAM : INPUT_STREAM;

  function CREATE_STREAM(CARD_LENGTH : POSITIVE) return INPUT_STREAM is
  begin
    return new INPUT_RECORD(CARD_LENGTH);
  end CREATE_STREAM;

  procedure SET_STREAM(STREAM : INPUT_STREAM) is
  begin
    DEFAULT_STREAM := STREAM;
  end SET_STREAM;

  procedure OPEN_INPUT(STREAM : INPUT_STREAM;
                       NAME   : STRING) is
  begin
    OPEN(STREAM.FILE,IN_FILE,NAME);
  end OPEN_INPUT;

  procedure OPEN_INPUT(NAME : STRING) is
  begin
    OPEN_INPUT(DEFAULT_STREAM,NAME);
  end OPEN_INPUT;

  procedure CLOSE_INPUT(STREAM : INPUT_STREAM) is
  begin
    CLOSE(STREAM.FILE);
  end CLOSE_INPUT;

  procedure CLOSE_INPUT is
  begin
    CLOSE_INPUT(DEFAULT_STREAM);
  end CLOSE_INPUT;

  function ALPHABETIC(C : CHARACTER) return BOOLEAN is
  begin
    return C in 'A'..'Z' or else C in 'a'..'z' or else C = '_';
  end ALPHABETIC;

  function NUMERIC(C : CHARACTER) return BOOLEAN is
  begin
    return C in '0'..'9' or else C = '_';
  end NUMERIC;

  function WHITESPACE(C : CHARACTER) return BOOLEAN is
  begin
    return C = ' ' or else C = ASCII.HT;
  end WHITESPACE;

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

  procedure NEXT_TOKEN(STREAM : INPUT_STREAM) is
  begin
    loop
      if STREAM.NEXT > STREAM.LAST then
        NEXT_LINE(STREAM);
      end if;
      if STREAM.BUFFER(STREAM.NEXT) = '-' and then
          STREAM.NEXT < STREAM.LAST and then
          STREAM.BUFFER(STREAM.NEXT+1) = '-' then
        NEXT_LINE(STREAM);
      end if;
      exit when not WHITESPACE(STREAM.BUFFER(STREAM.NEXT));
      STREAM.NEXT := STREAM.NEXT + 1;
    end loop;
  end NEXT_TOKEN;

  function TOKEN_END(STREAM : INPUT_STREAM) return POSITIVE is
    C   : CHARACTER;
    PTR : POSITIVE;
  begin
    NEXT_TOKEN(STREAM);
    PTR := STREAM.NEXT;
    while PTR <= STREAM.LAST loop
      C := STREAM.BUFFER(PTR);
      exit when WHITESPACE(C);
      case STREAM.BUFFER(STREAM.NEXT) is
        when 'A'..'Z' | 'a'..'z' =>
          exit when not ALPHABETIC(C) and then not NUMERIC(C);
        when '0'..'9' | '-' | '+' =>
          exit when not NUMERIC(C);
        when others =>
          exit when ALPHABETIC(C) or else NUMERIC(C);
      end case;
      PTR := PTR + 1;
    end loop;
    return PTR - 1;
  end TOKEN_END;

  procedure GET_STRING(STREAM : in  INPUT_STREAM;
                       STR    : out STRING;
                       LAST   : out NATURAL) is
    TOKEND,
    TLAST : POSITIVE;
  begin
    TOKEND := TOKEN_END(STREAM);
    TLAST := STR'FIRST + TOKEND - STREAM.NEXT;
    STR(STR'FIRST..TLAST) := STREAM.BUFFER(STREAM.NEXT..TOKEND);
    LAST := TLAST;
    STREAM.NEXT := TOKEND + 1;
  end GET_STRING;

  procedure GET_STRING(STR  : out STRING;
                       LAST : out NATURAL) is
  begin
    GET_STRING(DEFAULT_STREAM,STR,LAST);
  end GET_STRING;

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

  function GET_INTEGER return INTEGER is
  begin
    return GET_INTEGER(DEFAULT_STREAM);
  end GET_INTEGER;

  procedure GOBBLE(STREAM : INPUT_STREAM;
                   STR    : STRING) is
    S    : STRING(1..STREAM.CARD_LENGTH);
    LAST : INTEGER;
  begin
    GET_STRING(STREAM,S,LAST);
    if S(1..LAST) /= STR then
      raise CONSTRAINT_ERROR;
    end if;
  end GOBBLE;

  procedure GOBBLE(STR : STRING) is
  begin
    GOBBLE(DEFAULT_STREAM,STR);
  end GOBBLE;

end TOKEN_INPUT;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--ddldefs.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
package DDL_DEFINITIONS is

  type TYPE_TYPE is (SUB_TYPE, REC_ORD, ENUMERATION, INT_EGER, FL_OAT,
      STR_ING);

  type TYPE_NAME_STRING is new STRING;
  type TYPE_NAME        is access TYPE_NAME_STRING;

  type TYPE_DESCRIPTOR(TY_PE : TYPE_TYPE);
  type ACCESS_TYPE_DESCRIPTOR is access TYPE_DESCRIPTOR;

  subtype ACCESS_SUBTYPE_DESCRIPTOR     is ACCESS_TYPE_DESCRIPTOR(SUB_TYPE);
  subtype ACCESS_RECORD_DESCRIPTOR      is ACCESS_TYPE_DESCRIPTOR(REC_ORD);
  subtype ACCESS_ENUMERATION_DESCRIPTOR is ACCESS_TYPE_DESCRIPTOR(ENUMERATION);
  subtype ACCESS_INTEGER_DESCRIPTOR     is ACCESS_TYPE_DESCRIPTOR(INT_EGER);
  subtype ACCESS_FLOAT_DESCRIPTOR       is ACCESS_TYPE_DESCRIPTOR(FL_OAT);
  subtype ACCESS_STRING_DESCRIPTOR      is ACCESS_TYPE_DESCRIPTOR(STR_ING);

  type COMPONENT_NAME_STRING is new STRING;
  type COMPONENT_NAME        is access COMPONENT_NAME_STRING;

  type COMPONENT_DESCRIPTOR;
  type ACCESS_COMPONENT_DESCRIPTOR is access COMPONENT_DESCRIPTOR;

  type COMPONENT_DESCRIPTOR is
    record
      NEXT_COMPONENT,
      PREVIOUS_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;
      NAME               : COMPONENT_NAME;
      TY_PE,
      PARENT_RECORD      : ACCESS_TYPE_DESCRIPTOR;
    end record;

  type SUBRECORD_INDICATOR is new BOOLEAN;

  type LITERAL_DESCRIPTOR;
  type ACCESS_LITERAL_DESCRIPTOR is access LITERAL_DESCRIPTOR;

  type ENUMERATION_NAME_STRING is new STRING;
  type ENUMERATION_NAME        is access ENUMERATION_NAME_STRING;

  type ENUMERATION_POS is new NATURAL;

  type LITERAL_DESCRIPTOR is
    record
      NEXT_LITERAL,
      PREVIOUS_LITERAL : ACCESS_LITERAL_DESCRIPTOR;
      NAME             : ENUMERATION_NAME;
      POS              : ENUMERATION_POS;
      PARENT_TYPE      : ACCESS_TYPE_DESCRIPTOR;
    end record;

  type STRING_LENGTH is new NATURAL;

  type TYPE_DESCRIPTOR(TY_PE : TYPE_TYPE) is
    record
      NAME         : TYPE_NAME;
      NEXT_TYPE,
      PREVIOUS_TYPE,
      FIRST_SUBTYPE,
      LAST_SUBTYPE : ACCESS_TYPE_DESCRIPTOR;
      case TY_PE is
        when SUB_TYPE =>
          PARENT_TYPE,
          TOP_TYPE,
          NEXT_SUBTYPE,
          PREVIOUS_SUBTYPE : ACCESS_TYPE_DESCRIPTOR;
        when REC_ORD =>
          FIRST_COMPONENT,
          LAST_COMPONENT   : ACCESS_COMPONENT_DESCRIPTOR;
          IS_SUBRECORD     : SUBRECORD_INDICATOR := FALSE;
        when ENUMERATION =>
          FIRST_LITERAL,
          LAST_LITERAL     : ACCESS_LITERAL_DESCRIPTOR;
          LAST_POS         : ENUMERATION_POS := 0;
          MAX_LENGTH       : NATURAL := 0;
        when INT_EGER | FL_OAT =>
          null;
        when STR_ING =>
          LENGTH : STRING_LENGTH;
      end case;
    end record;

end DDL_DEFINITIONS;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--listutil.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DDL_DEFINITIONS;
  use DDL_DEFINITIONS;

package LIST_UTILITIES is

  function FIRST_TYPE_DESCRIPTOR return ACCESS_TYPE_DESCRIPTOR;

  function FIND_TYPE_DESCRIPTOR(NAME : TYPE_NAME_STRING)
      return ACCESS_TYPE_DESCRIPTOR;

  procedure ADD_TYPE(T : ACCESS_TYPE_DESCRIPTOR);

  procedure ADD_SUBTYPE(PARENT : ACCESS_TYPE_DESCRIPTOR;
                        CHILD  : ACCESS_SUBTYPE_DESCRIPTOR);

  procedure ADD_LITERAL(PARENT : ACCESS_ENUMERATION_DESCRIPTOR;
                        CHILD  : ACCESS_LITERAL_DESCRIPTOR);

  procedure ADD_COMPONENT(PARENT : ACCESS_RECORD_DESCRIPTOR;
                          CHILD  : ACCESS_COMPONENT_DESCRIPTOR);

end LIST_UTILITIES;

package body LIST_UTILITIES is

  TYPE_DESCRIPTOR_0,                          -- type listhead -- first & last
  TYPE_DESCRIPTOR_9 : ACCESS_TYPE_DESCRIPTOR; --  type descriptors

  function FIRST_TYPE_DESCRIPTOR return ACCESS_TYPE_DESCRIPTOR is
  begin
    return TYPE_DESCRIPTOR_0;
  end FIRST_TYPE_DESCRIPTOR;

  function FIND_TYPE_DESCRIPTOR(NAME : TYPE_NAME_STRING)
      return ACCESS_TYPE_DESCRIPTOR is
    T : ACCESS_TYPE_DESCRIPTOR := TYPE_DESCRIPTOR_0;
  begin
    while T.NAME.all /= NAME loop
      T := T.NEXT_TYPE; -- CONSTRAINT_ERROR if non-existent type name
    end loop;
    return T;
  end FIND_TYPE_DESCRIPTOR;

  procedure ADD_TYPE(T : ACCESS_TYPE_DESCRIPTOR) is
  begin
    if TYPE_DESCRIPTOR_9 = null then
      TYPE_DESCRIPTOR_0 := T;
    else
      TYPE_DESCRIPTOR_9.NEXT_TYPE := T;
    end if;
    T.PREVIOUS_TYPE := TYPE_DESCRIPTOR_9;
    TYPE_DESCRIPTOR_9 := T;
    T.NEXT_TYPE := null;
  end ADD_TYPE;

  procedure ADD_SUBTYPE(PARENT : ACCESS_TYPE_DESCRIPTOR;
                        CHILD  : ACCESS_SUBTYPE_DESCRIPTOR) is
  begin
    if PARENT.LAST_SUBTYPE = null then
      PARENT.FIRST_SUBTYPE := CHILD;
    else
      PARENT.LAST_SUBTYPE.NEXT_SUBTYPE := CHILD;
    end if;
    CHILD.PREVIOUS_SUBTYPE := PARENT.LAST_SUBTYPE;
    PARENT.LAST_SUBTYPE := CHILD;
    CHILD.NEXT_SUBTYPE := null;
    CHILD.PARENT_TYPE := PARENT;
  end ADD_SUBTYPE;

  procedure ADD_LITERAL(PARENT : ACCESS_ENUMERATION_DESCRIPTOR;
                        CHILD  : ACCESS_LITERAL_DESCRIPTOR) is
  begin
    if PARENT.LAST_LITERAL = null then
      PARENT.FIRST_LITERAL := CHILD;
    else
      PARENT.LAST_LITERAL.NEXT_LITERAL := CHILD;
    end if;
    CHILD.PREVIOUS_LITERAL := PARENT.LAST_LITERAL;
    PARENT.LAST_LITERAL := CHILD;
    CHILD.NEXT_LITERAL := null;
    CHILD.PARENT_TYPE := PARENT;
  end ADD_LITERAL;

  procedure ADD_COMPONENT(PARENT : ACCESS_RECORD_DESCRIPTOR;
                          CHILD  : ACCESS_COMPONENT_DESCRIPTOR) is
  begin
    if PARENT.LAST_COMPONENT = null then
      PARENT.FIRST_COMPONENT := CHILD;
    else
      PARENT.LAST_COMPONENT.NEXT_COMPONENT := CHILD;
    end if;
    CHILD.PREVIOUS_COMPONENT := PARENT.LAST_COMPONENT;
    PARENT.LAST_COMPONENT := CHILD;
    CHILD.NEXT_COMPONENT := null;
    CHILD.PARENT_RECORD := PARENT;
  end ADD_COMPONENT;

end LIST_UTILITIES;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--readddl.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DDL_DEFINITIONS, LIST_UTILITIES, TOKEN_INPUT;
  use DDL_DEFINITIONS, LIST_UTILITIES, TOKEN_INPUT;

package READ_DDL is

  procedure SCAN_DDL(PACKAGE_NAME : out STRING;
                     LAST         : out POSITIVE);

end READ_DDL;

package body READ_DDL is

  procedure PROCESS_DERIVED_TYPE(NEW_NAME : TYPE_NAME) is
    KEYWORD  : STRING(1..7);
    LAST     : POSITIVE;
    STR_LAST : STRING_LENGTH;
  begin
    GET_STRING(KEYWORD,LAST);
    if KEYWORD(1..LAST) = "INTEGER" then
      ADD_TYPE ( new TYPE_DESCRIPTOR'(TY_PE => INT_EGER, NAME => NEW_NAME,
          others => null) );
      GOBBLE(";");
    elsif KEYWORD(1..LAST) = "FLOAT" then
      ADD_TYPE ( new TYPE_DESCRIPTOR'(TY_PE => FL_OAT,   NAME => NEW_NAME,
          others => null) );
      GOBBLE(";");
    elsif KEYWORD(1..LAST) = "STRING" then
      GOBBLE("("); GOBBLE("1"); GOBBLE("..");
      STR_LAST := STRING_LENGTH(GET_INTEGER);
      ADD_TYPE ( new TYPE_DESCRIPTOR'(TY_PE => STR_ING,  NAME => NEW_NAME,
          LENGTH => STR_LAST, others => null) );
      GOBBLE(");");
    else
      raise CONSTRAINT_ERROR; -- unrecognized type keyword
    end if;
  end PROCESS_DERIVED_TYPE;

  procedure PROCESS_ENUMERATION_TYPE(NEW_NAME : TYPE_NAME) is
    PARENT    : ACCESS_ENUMERATION_DESCRIPTOR;
    LITERAL   : ENUMERATION_NAME_STRING(1..80);
    LAST      : POSITIVE;
    DELIMITER : STRING(1..2);
  begin
    PARENT := new TYPE_DESCRIPTOR'(TY_PE => ENUMERATION, NAME => NEW_NAME,
        LAST_POS => 0, MAX_LENGTH => 0, FIRST_LITERAL | LAST_LITERAL => null,
        others => null);
    ADD_TYPE(PARENT);
    loop
      GET_STRING(STRING(LITERAL),LAST);
      PARENT.LAST_POS := PARENT.LAST_POS + 1;
      if LAST > PARENT.MAX_LENGTH then
        PARENT.MAX_LENGTH := LAST;
      end if;
      ADD_LITERAL ( PARENT, new LITERAL_DESCRIPTOR'(
          NAME => new ENUMERATION_NAME_STRING'(LITERAL(1..LAST)),
          POS  => PARENT.LAST_POS, PARENT_TYPE => PARENT, others => null) );
      GET_STRING(DELIMITER,LAST);
      if DELIMITER(1..LAST) = ");" then
        exit;
      elsif DELIMITER(1..LAST) /= "," then
        raise CONSTRAINT_ERROR; -- invalid enumeration literal list
      end if;
    end loop;
  end PROCESS_ENUMERATION_TYPE;

  procedure PROCESS_RECORD_TYPE(NEW_NAME : TYPE_NAME) is
    FIELD_TYPE_NAME : TYPE_NAME_STRING(1..80);
    FIELD_NAME      : COMPONENT_NAME_STRING(1..80);
    FIELD_TYPE      : ACCESS_TYPE_DESCRIPTOR;
    PARENT          : ACCESS_RECORD_DESCRIPTOR;
    FIELD_TYPE_LAST,
    FIELD_LAST      : POSITIVE;
  begin
    PARENT := new TYPE_DESCRIPTOR'(TY_PE => REC_ORD, NAME => NEW_NAME,
        IS_SUBRECORD => FALSE, FIRST_COMPONENT | LAST_COMPONENT => null,
        others => null);
    ADD_TYPE(PARENT);
    loop
      GET_STRING(STRING(FIELD_NAME),FIELD_LAST);
      if FIELD_NAME(1..FIELD_LAST) = "end" then
        GOBBLE("record"); GOBBLE(";");
        exit;
      end if;
      GOBBLE(":");
      GET_STRING(STRING(FIELD_TYPE_NAME),FIELD_TYPE_LAST);
      FIELD_TYPE := FIND_TYPE_DESCRIPTOR(FIELD_TYPE_NAME(1..FIELD_TYPE_LAST));
      if FIELD_TYPE.TY_PE = REC_ORD then
        FIELD_TYPE.IS_SUBRECORD := TRUE;
      end if;
      ADD_COMPONENT ( PARENT, new COMPONENT_DESCRIPTOR' (
          NAME  => new COMPONENT_NAME_STRING'(FIELD_NAME(1..FIELD_LAST)),
          TY_PE => FIELD_TYPE, PARENT_RECORD => PARENT, others => null ) );
      GOBBLE(";");
    end loop;
  end PROCESS_RECORD_TYPE;

  procedure PROCESS_TYPE is
    NAME_STRING    : TYPE_NAME_STRING(1..80);
    NAME           : TYPE_NAME;
    LAST           : POSITIVE;
    TYPE_INDICATOR : STRING(1..6);
  begin
    GET_STRING(STRING(NAME_STRING),LAST);
    NAME := new TYPE_NAME_STRING'(NAME_STRING(1..LAST));
    GOBBLE("is");
    GET_STRING(TYPE_INDICATOR,LAST);
    if TYPE_INDICATOR(1..LAST) = "(" then
      PROCESS_ENUMERATION_TYPE(NAME);
    elsif TYPE_INDICATOR(1..LAST) = "new" then
      PROCESS_DERIVED_TYPE(NAME);
    elsif TYPE_INDICATOR(1..LAST) = "record" then
      PROCESS_RECORD_TYPE(NAME);
    else
      raise CONSTRAINT_ERROR; -- unrecognized type keyword/indicator
    end if;
  end PROCESS_TYPE;

  procedure PROCESS_SUBTYPE is
    CHILD_NAME,
    PARENT_NAME       : TYPE_NAME_STRING(1..80);
    CHILD_LAST,
    PARENT_LAST       : POSITIVE;
    PARENT_DESCRIPTOR : ACCESS_TYPE_DESCRIPTOR;
    CHILD_DESCRIPTOR  : ACCESS_SUBTYPE_DESCRIPTOR;
  begin
    GET_STRING(STRING(CHILD_NAME),CHILD_LAST);
    GOBBLE("is");
    GET_STRING(STRING(PARENT_NAME),PARENT_LAST);
    GOBBLE(";");
    PARENT_DESCRIPTOR := FIND_TYPE_DESCRIPTOR(PARENT_NAME(1..PARENT_LAST));
    CHILD_DESCRIPTOR := new TYPE_DESCRIPTOR' (
        TY_PE  => SUB_TYPE,
        NAME   => new TYPE_NAME_STRING'(CHILD_NAME(1..CHILD_LAST)),
        others => null );
    ADD_TYPE(CHILD_DESCRIPTOR);
    ADD_SUBTYPE(PARENT_DESCRIPTOR, CHILD_DESCRIPTOR);
    if PARENT_DESCRIPTOR.TY_PE = SUB_TYPE then
      CHILD_DESCRIPTOR.TOP_TYPE := PARENT_DESCRIPTOR.TOP_TYPE;
    else
      CHILD_DESCRIPTOR.TOP_TYPE := PARENT_DESCRIPTOR;
    end if;
  end PROCESS_SUBTYPE;

  procedure SCAN_DDL(PACKAGE_NAME : out STRING;
                     LAST         : out POSITIVE) is
    KEYWORD : STRING(1..7);
    KLAST   : POSITIVE;
  begin
    GOBBLE("package");
    GET_STRING(PACKAGE_NAME,LAST);
    GOBBLE("is");
    loop
      GET_STRING(KEYWORD,KLAST);
      if KEYWORD(1..KLAST) = "type" then
        PROCESS_TYPE;
      elsif KEYWORD(1..KLAST) = "subtype" then
        PROCESS_SUBTYPE;
      elsif KEYWORD(1..KLAST) = "end" then
        exit;
      else
        raise CONSTRAINT_ERROR; -- unrecognized keyword
      end if;
    end loop;
  end SCAN_DDL;

end READ_DDL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--sqlddl.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with DDL_DEFINITIONS;
use DDL_DEFINITIONS;

with LIST_UTILITIES;
use LIST_UTILITIES;

with TEXT_IO;
use TEXT_IO;

package SQL_DDL is

procedure GENERATE_SQL_DDL (DATABASE_NAME : STRING);

end SQL_DDL;

package body SQL_DDL is

procedure GENERATE_SQL_DDL (DATABASE_NAME : STRING) is

    package INT_IO is new INTEGER_IO (INTEGER);

    MAX_LINE_LENGTH : constant INTEGER := 120;

    INDENT_COLUMN_POSITION : constant INTEGER := 40;

    type FIELD_NODE;

    type ACCESS_FIELD_NODE is access FIELD_NODE;

    type FIELD_NODE is

      record
    NEXT_FIELD : ACCESS_FIELD_NODE;
    NAME       : STRING (1 .. 80);

      end record;

    DEFINITION_FILE      : FILE_TYPE;
    UNDERLYING_FILE      : FILE_TYPE;

    DEFINITION_FILE_NAME : STRING (1 .. 20);
    UNDERLYING_FILE_NAME : STRING (1 .. 20);

    LINE                 : STRING (1 .. MAX_LINE_LENGTH) :=
               (1 .. MAX_LINE_LENGTH => ' ');

    BLANK_CARD           : STRING (1 .. MAX_LINE_LENGTH) :=
               (1 .. MAX_LINE_LENGTH => ' ');

    LENGTH               : NATURAL;

    FIRST_FIELD_NODE     : ACCESS_FIELD_NODE;

    function LAST_FUNCTIONAL_POS (LINE : STRING) return INTEGER is

      POSITION    : NATURAL;
      INPUT_FIRST : NATURAL := LINE'FIRST;

    begin

      POSITION := LINE'LAST;

      while (POSITION > INPUT_FIRST) and then
        (CHARACTER'POS (LINE (POSITION)) <= CHARACTER'POS (' ')) loop

    POSITION := POSITION - 1;

      end loop;

      if POSITION < INPUT_FIRST then
    -- compensate for null input
    POSITION := INPUT_FIRST;   -- string

      end if;

      return POSITION;

    end LAST_FUNCTIONAL_POS;

    procedure INSERT_SLICE (LINE   : in out STRING;
                INSERT : STRING;
                POS    : INTEGER) is

      LINE_LAST                : INTEGER := LINE'LAST;
      INSERT_LENGTH            : INTEGER := INSERT'LENGTH;
      INSERT_POSITION          : INTEGER := POS;
      NUMBER_OF_OVERFLOW_CHARS : INTEGER;

    begin

      if LINE'LENGTH > 0 and INSERT_LENGTH > 0 then

-- compensate for bad position request

    if INSERT_POSITION > LINE_LAST then
      INSERT_POSITION := LINE_LAST;
    end if;

    if INSERT_POSITION < 1 then
      INSERT_POSITION := 1;
    end if;

    NUMBER_OF_OVERFLOW_CHARS :=
      INSERT_POSITION - LINE_LAST + INSERT_LENGTH - 1;

    if NUMBER_OF_OVERFLOW_CHARS > 0 then
      INSERT_LENGTH := INSERT_LENGTH - NUMBER_OF_OVERFLOW_CHARS;
    end if;

    LINE (INSERT_POSITION .. (INSERT_POSITION + INSERT_LENGTH - 1)) :=
      INSERT (INSERT'FIRST .. (INSERT'FIRST + INSERT_LENGTH - 1));

      end if;

    end INSERT_SLICE;


    procedure INSERT_LINE (LINE    : in out STRING;
               LITERAL : STRING;
               POS     : POSITIVE) is

    begin

      if LINE (POS - 1) = ' ' then

    INSERT_SLICE (LINE, LITERAL, POS);

      else

    INSERT_SLICE (LINE, LITERAL, LAST_FUNCTIONAL_POS (LINE) + 2);

      end if;

    end INSERT_LINE;

    procedure CREATE_FIELD_LIST (FIRST_FIELD_NODE : in out ACCESS_FIELD_NODE) is

      CURRENT_FIELD     : ACCESS_FIELD_NODE;
      CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
      CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;
      LITERAL           : STRING (1 .. 80);

    begin

      FIRST_FIELD_NODE := new FIELD_NODE;
      CURRENT_FIELD := new FIELD_NODE;
      FIRST_FIELD_NODE.NEXT_FIELD := CURRENT_FIELD;

      loop

    if (CURRENT_TYPE.TY_PE = REC_ORD) and then
       (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

      CURRENT_COMPONENT := CURRENT_TYPE.FIRST_COMPONENT;

          loop

        CURRENT_FIELD.NAME := BLANK_CARD (1 .. 80);
        LITERAL := BLANK_CARD (1 .. 80);
        INSERT_SLICE (LITERAL, STRING (CURRENT_COMPONENT.NAME.all), 1);
        CURRENT_FIELD.NAME := LITERAL;

        CURRENT_FIELD.NEXT_FIELD := new FIELD_NODE;
        CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;

        exit when CURRENT_COMPONENT.NEXT_COMPONENT = null;

        CURRENT_COMPONENT := CURRENT_COMPONENT.NEXT_COMPONENT;

      end loop;

    end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

    CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

      end loop;

    end CREATE_FIELD_LIST;


    procedure CREATE_UNDERLYING_PACKAGE
         (FIRST_FIELD_NODE : ACCESS_FIELD_NODE;
          DATABASE_NAME    : STRING;
          UNDERLYING_FILE  : in out FILE_TYPE) is

      procedure GENERATE_TYPE_DEFINITIONS
           (UNDERLYING_FILE : in out FILE_TYPE) is

    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        NEW_LINE (UNDERLYING_FILE);
        PUT (UNDERLYING_FILE, "  TYPE ");
        PUT (UNDERLYING_FILE, STRING (CURRENT_TYPE.NAME.all));
        PUT_LINE (UNDERLYING_FILE, "_TYPE is ");
        PUT_LINE (UNDERLYING_FILE, "     record");

        PUT (UNDERLYING_FILE, "         STAR");

        CURRENT_COMPONENT := CURRENT_TYPE.FIRST_COMPONENT;

        loop

          PUT (UNDERLYING_FILE, ", ");
          PUT (UNDERLYING_FILE, STRING (CURRENT_COMPONENT.NAME.all));

          if COL (UNDERLYING_FILE) > 70 then

        NEW_LINE (UNDERLYING_FILE);
        PUT (UNDERLYING_FILE, "         ");

          end if;

          exit when CURRENT_COMPONENT.NEXT_COMPONENT = null;

          CURRENT_COMPONENT := CURRENT_COMPONENT.NEXT_COMPONENT;

        end loop;

        PUT_LINE (UNDERLYING_FILE, " : FIELD;");
        PUT_LINE (UNDERLYING_FILE, "     end record;");

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

      end GENERATE_TYPE_DEFINITIONS;


      procedure GENERATE_TABLE_ACCESS_DEFINITIONS
           (UNDERLYING_FILE : in out FILE_TYPE) is

    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (UNDERLYING_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "type", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 8);
        INSERT_SLICE (LINE, "_TABLE", (LAST_FUNCTIONAL_POS (LINE) + 1));

        INSERT_LINE (LINE, "is access", INDENT_COLUMN_POSITION);

        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TYPE;", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);
      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (UNDERLYING_FILE);


      end GENERATE_TABLE_ACCESS_DEFINITIONS;


      procedure GENERATE_FIELD_CONSTANT_DEFINITIONS
           (FIRST_FIELD_NODE : ACCESS_FIELD_NODE;
            UNDERLYING_FILE  : in out FILE_TYPE) is

    FIELD_IS_UNIQUE : BOOLEAN;

    CURRENT_FIELD   : ACCESS_FIELD_NODE := FIRST_FIELD_NODE;


    procedure SEARCH_FIELD_LIST_FOR_DUPLICITY
             (FIELD_ELEMENT   : ACCESS_FIELD_NODE;
              FIELD_IS_UNIQUE : out BOOLEAN) is

      FIELD_NODE           : ACCESS_FIELD_NODE := FIELD_ELEMENT;
      NUMBER_OF_OCCURANCES : INTEGER := 0;

    begin

      FIELD_NODE := FIELD_NODE.NEXT_FIELD;

         if FIELD_NODE /= null then

           loop

        if FIELD_NODE.NAME = FIELD_ELEMENT.NAME then

          NUMBER_OF_OCCURANCES := NUMBER_OF_OCCURANCES + 1;

        end if;

        exit when FIELD_NODE.NEXT_FIELD = null;

        FIELD_NODE := FIELD_NODE.NEXT_FIELD;

      end loop;

          end if;

      if NUMBER_OF_OCCURANCES > 0 then

        FIELD_IS_UNIQUE := FALSE;

      else

        FIELD_IS_UNIQUE := TRUE;

      end if;

    end SEARCH_FIELD_LIST_FOR_DUPLICITY;

      begin

    CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;

    loop

      LINE := BLANK_CARD;

      SEARCH_FIELD_LIST_FOR_DUPLICITY (CURRENT_FIELD, FIELD_IS_UNIQUE);

      if FIELD_IS_UNIQUE then

        INSERT_SLICE (LINE, "F_", 3);
        INSERT_SLICE (LINE, CURRENT_FIELD.NAME, 5);
        INSERT_LINE (LINE, ": constant FIELD := MAKE_FIELD(""", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, CURRENT_FIELD.NAME,
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, """);", (LAST_FUNCTIONAL_POS (LINE) + 1));
        PUT_LINE (UNDERLYING_FILE, LINE);

      end if;

      CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;

      exit when CURRENT_FIELD.NEXT_FIELD = null;

    end loop;

    NEW_LINE (UNDERLYING_FILE);

      end GENERATE_FIELD_CONSTANT_DEFINITIONS;


      procedure GENERATE_DATA_DEFINITIONS
           (UNDERLYING_FILE : in out FILE_TYPE) is


    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 3);
        INSERT_SLICE (LINE, "_DATA", (LAST_FUNCTIONAL_POS (LINE) + 1));

        INSERT_LINE (LINE, ": ", INDENT_COLUMN_POSITION);

        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TABLE;", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (UNDERLYING_FILE);

      end GENERATE_DATA_DEFINITIONS;


      procedure GENERATE_PROCEDURE_SPECIFICATION_DEFINITIONS
           (UNDERLYING_FILE : in out FILE_TYPE) is


    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (UNDERLYING_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "procedure", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 13);
        INSERT_SLICE (LINE, "(X : in out", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TABLE);", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (UNDERLYING_FILE);

      end GENERATE_PROCEDURE_SPECIFICATION_DEFINITIONS;


      procedure GENERATE_PROCEDURE_BODY_DECLARATIONS
           (UNDERLYING_FILE : in out FILE_TYPE) is


    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "procedure", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 13);
        INSERT_SLICE (LINE, "(X : in out",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TABLE) is", (LAST_FUNCTIONAL_POS (LINE) + 1));
        PUT_LINE (UNDERLYING_FILE, LINE);

        NEW_LINE (UNDERLYING_FILE);
        PUT_LINE (UNDERLYING_FILE, "     T : TABLE_NAME;");
        NEW_LINE (UNDERLYING_FILE);
        PUT_LINE (UNDERLYING_FILE, "   begin");
        NEW_LINE (UNDERLYING_FILE);
        PUT_LINE (UNDERLYING_FILE, "     if X = null then");
        NEW_LINE (UNDERLYING_FILE);

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "T := MAKE_TABLE_NAME(""", 9);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, """);", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "X := new", 9);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TYPE'(", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);
        PUT_LINE (UNDERLYING_FILE, "        MAKE_FIELD(T, STAR),");
        LINE := BLANK_CARD;

        CURRENT_COMPONENT := CURRENT_TYPE.FIRST_COMPONENT;

        loop

          LINE := BLANK_CARD;

          INSERT_SLICE (LINE, "MAKE_FIELD(T, F_", 9);
          INSERT_SLICE (LINE, STRING (CURRENT_COMPONENT.NAME.all),
                (LAST_FUNCTIONAL_POS (LINE) + 1));

          if CURRENT_COMPONENT.NEXT_COMPONENT /= null then

        INSERT_SLICE (LINE, "),", (LAST_FUNCTIONAL_POS (LINE) + 1));
          else
        INSERT_SLICE (LINE, ") );", (LAST_FUNCTIONAL_POS (LINE) + 1));
          end if;

          PUT_LINE (UNDERLYING_FILE, LINE);

          exit when CURRENT_COMPONENT.NEXT_COMPONENT = null;

          CURRENT_COMPONENT := CURRENT_COMPONENT.NEXT_COMPONENT;

        end loop;

        NEW_LINE (UNDERLYING_FILE);
        PUT_LINE (UNDERLYING_FILE, "      end if;");
        NEW_LINE (UNDERLYING_FILE);
        PUT (UNDERLYING_FILE, "   end ");
        PUT (UNDERLYING_FILE, STRING (CURRENT_TYPE.NAME.all));
        PUT_LINE (UNDERLYING_FILE, "; ");
        NEW_LINE (UNDERLYING_FILE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;


    NEW_LINE (UNDERLYING_FILE);

      end GENERATE_PROCEDURE_BODY_DECLARATIONS;


      procedure GENERATE_TABLE_INITIALIZATION
           (UNDERLYING_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 6);
        INSERT_LINE (LINE, " (", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              LAST_FUNCTIONAL_POS (LINE) + 2);
        INSERT_SLICE (LINE, "_DATA);", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (UNDERLYING_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

      end GENERATE_TABLE_INITIALIZATION;

    begin

      NEW_LINE (UNDERLYING_FILE);
      PUT_LINE (UNDERLYING_FILE, "with SQL_DEFINITIONS;");
      PUT_LINE (UNDERLYING_FILE, "use  SQL_DEFINITIONS;");
      NEW_LINE (UNDERLYING_FILE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "package ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 9);
      INSERT_SLICE (LINE, "_UNDERLYING is ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (UNDERLYING_FILE, LINE);
      NEW_LINE (UNDERLYING_FILE);

      GENERATE_TYPE_DEFINITIONS (UNDERLYING_FILE);

      GENERATE_TABLE_ACCESS_DEFINITIONS (UNDERLYING_FILE);

      GENERATE_FIELD_CONSTANT_DEFINITIONS (FIRST_FIELD_NODE, UNDERLYING_FILE);

      GENERATE_DATA_DEFINITIONS (UNDERLYING_FILE);

      GENERATE_PROCEDURE_SPECIFICATION_DEFINITIONS (UNDERLYING_FILE);

      NEW_LINE (UNDERLYING_FILE);
      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "end ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 5);
      INSERT_SLICE (LINE, "_UNDERLYING", LAST_FUNCTIONAL_POS (LINE) + 1);
      INSERT_SLICE (LINE, "; ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (UNDERLYING_FILE, LINE);

      NEW_LINE (UNDERLYING_FILE);
      PUT_LINE (UNDERLYING_FILE, "with SQL_DEFINITIONS;");
      PUT_LINE (UNDERLYING_FILE, "use  SQL_DEFINITIONS;");
      NEW_LINE (UNDERLYING_FILE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "package body ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 14);
      INSERT_SLICE (LINE, "_UNDERLYING is ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (UNDERLYING_FILE, LINE);
      NEW_LINE (UNDERLYING_FILE);

      GENERATE_PROCEDURE_BODY_DECLARATIONS (UNDERLYING_FILE);

      NEW_LINE (UNDERLYING_FILE);
      PUT_LINE (UNDERLYING_FILE, "    begin");
      NEW_LINE (UNDERLYING_FILE);

      GENERATE_TABLE_INITIALIZATION (UNDERLYING_FILE);

      NEW_LINE (UNDERLYING_FILE);
      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, " end ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 6);
      INSERT_SLICE (LINE, "_UNDERLYING", LAST_FUNCTIONAL_POS (LINE) + 1);
      INSERT_SLICE (LINE, "; ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (UNDERLYING_FILE, LINE);

    end CREATE_UNDERLYING_PACKAGE;

    procedure CREATE_DATABASE_DEFINITIONS_FILE
         (FIRST_FIELD_NODE : ACCESS_FIELD_NODE;
          DATABASE_NAME    : STRING;
          DEFINITION_FILE  : in out FILE_TYPE) is


      procedure GENERATE_TYPE_SUBTYPE_DECLARATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "subtype", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 11);
        INSERT_SLICE (LINE, "_TYPE", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_LINE (LINE, "is", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, DATABASE_NAME, LAST_FUNCTIONAL_POS (LINE) + 2);
        INSERT_SLICE (LINE, "_UNDERLYING.",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "_TYPE;", (LAST_FUNCTIONAL_POS (LINE) + 1));
        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_TYPE_SUBTYPE_DECLARATIONS;


      procedure GENERATE_TABLE_SUBTYPE_DEFINITIONS
           (DEFINITION_FILE : in out FILE_TYPE) is


    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;


      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "subtype", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 11);
        INSERT_SLICE (LINE, "_TABLE", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_LINE (LINE, "is", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, DATABASE_NAME,
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_UNDERLYING.",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "_TABLE;", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_TABLE_SUBTYPE_DEFINITIONS;


      procedure GENERATE_FIELD_SUBTYPE_REDEFINITIONS
           (FIRST_FIELD_NODE : ACCESS_FIELD_NODE;
            UNDERLYING_FILE  : in out FILE_TYPE) is

    FIELD_IS_UNIQUE : BOOLEAN;

    CURRENT_FIELD   : ACCESS_FIELD_NODE := FIRST_FIELD_NODE;


    procedure SEARCH_FIELD_LIST_FOR_DUPLICITY
             (FIELD_ELEMENT   : ACCESS_FIELD_NODE;
              FIELD_IS_UNIQUE : out BOOLEAN) is

      FIELD_NODE           : ACCESS_FIELD_NODE := FIELD_ELEMENT;
      NUMBER_OF_OCCURANCES : INTEGER := 0;

    begin

      FIELD_NODE := FIELD_NODE.NEXT_FIELD;

          if FIELD_NODE /= null then

            loop

        if FIELD_NODE.NAME = FIELD_ELEMENT.NAME then

          NUMBER_OF_OCCURANCES := NUMBER_OF_OCCURANCES + 1;

        end if;

        exit when FIELD_NODE.NEXT_FIELD = null;

        FIELD_NODE := FIELD_NODE.NEXT_FIELD;

      end loop;

          end if;

      if NUMBER_OF_OCCURANCES > 0 then

        FIELD_IS_UNIQUE := FALSE;

      else

        FIELD_IS_UNIQUE := TRUE;

      end if;

    end SEARCH_FIELD_LIST_FOR_DUPLICITY;

      begin

    CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;

    loop

      LINE := BLANK_CARD;

      SEARCH_FIELD_LIST_FOR_DUPLICITY (CURRENT_FIELD, FIELD_IS_UNIQUE);

      if FIELD_IS_UNIQUE then

        LINE := BLANK_CARD;
        INSERT_SLICE (LINE, "function", 3);
        INSERT_SLICE (LINE, CURRENT_FIELD.NAME, 12);
        INSERT_LINE (LINE, "is new GET_FIELD_NAME(", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, DATABASE_NAME,
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_UNDERLYING.F_",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, CURRENT_FIELD.NAME,
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "); ", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;


      CURRENT_FIELD := CURRENT_FIELD.NEXT_FIELD;

      exit when CURRENT_FIELD.NEXT_FIELD = null;

    end loop;

      end GENERATE_FIELD_SUBTYPE_REDEFINITIONS;


      procedure GENERATE_TABLE_FUNCTION_REINSTANTIATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "function", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 12);
        INSERT_LINE (LINE, "is new GET_TABLE(", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "_DATA.STAR);",
              (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_TABLE_FUNCTION_REINSTANTIATIONS;


      procedure GENERATE_GET_FIELD_FUNCTION_INSTANTIATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;


      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "function", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 12);
        INSERT_SLICE (LINE, "is", (LAST_FUNCTIONAL_POS (LINE) + 2));

        PUT_LINE (DEFINITION_FILE, LINE);
        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "new GET_FIELDS(", 5);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 20);
        INSERT_SLICE (LINE, "_TABLE,", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "_DATA);", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_GET_FIELD_FUNCTION_INSTANTIATIONS;


      procedure GENERATE_INSERT_FIELD_FUNCTION_INSTANTIATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is


    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "function", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 12);
        INSERT_LINE (LINE, "is new INSERT_FIELDS(", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "_DATA.STAR);",
              (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_INSERT_FIELD_FUNCTION_INSTANTIATIONS;


      procedure GENERATE_TABLE_PROCEDURE_REDEFINITIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "procedure", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 13);
        INSERT_SLICE (LINE, "(X : in out",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TABLE", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, ") ", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);
        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "renames", 13);
        INSERT_SLICE (LINE, DATABASE_NAME,
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_UNDERLYING.",
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, "; ", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);
        NEW_LINE (DEFINITION_FILE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_TABLE_PROCEDURE_REDEFINITIONS;

      procedure GENERATE_TABLE_FUNCTION_DECLARATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        NEW_LINE (DEFINITION_FILE);
        INSERT_SLICE (LINE, "function", 2);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 12);
        INSERT_LINE (LINE, "(X : ", INDENT_COLUMN_POSITION);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              LAST_FUNCTIONAL_POS (LINE) + 2);
        INSERT_SLICE (LINE, "_TABLE", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, ") ", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_LINE (LINE, "return TABLE;", 65);

        PUT_LINE (DEFINITION_FILE, LINE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_TABLE_FUNCTION_DECLARATIONS;

      procedure GENERATE_FUNCTION_BODY_DECLARATIONS
           (DEFINITION_FILE : in out FILE_TYPE) is

    CURRENT_FIELD     : ACCESS_FIELD_NODE;
    CURRENT_TYPE      : ACCESS_TYPE_DESCRIPTOR := FIRST_TYPE_DESCRIPTOR;
    CURRENT_COMPONENT : ACCESS_COMPONENT_DESCRIPTOR;

      begin

    NEW_LINE (DEFINITION_FILE);

    loop

      if (CURRENT_TYPE.TY_PE = REC_ORD) and then
         (CURRENT_TYPE.IS_SUBRECORD = FALSE) then

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "function", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 12);
        INSERT_SLICE (LINE, "(X : in", (LAST_FUNCTIONAL_POS (LINE) + 1));
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all),
              (LAST_FUNCTIONAL_POS (LINE) + 2));
        INSERT_SLICE (LINE, "_TABLE) return TABLE is",
              (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);
        PUT_LINE (DEFINITION_FILE, "   begin");
        NEW_LINE (DEFINITION_FILE);
        PUT_LINE (DEFINITION_FILE, "     return TABLEIFY(X.STAR);");
        NEW_LINE (DEFINITION_FILE);

        LINE := BLANK_CARD;

        INSERT_SLICE (LINE, "end", 3);
        INSERT_SLICE (LINE, STRING (CURRENT_TYPE.NAME.all), 7);
        INSERT_SLICE (LINE, "; ", (LAST_FUNCTIONAL_POS (LINE) + 1));

        PUT_LINE (DEFINITION_FILE, LINE);
        NEW_LINE (DEFINITION_FILE);

      end if;

      exit when CURRENT_TYPE.NEXT_TYPE = null;

      CURRENT_TYPE := CURRENT_TYPE.NEXT_TYPE;

    end loop;

    NEW_LINE (DEFINITION_FILE);

      end GENERATE_FUNCTION_BODY_DECLARATIONS;

    begin

      NEW_LINE (DEFINITION_FILE);
      PUT_LINE (DEFINITION_FILE, "with SQL_DEFINITIONS;");
      PUT_LINE (DEFINITION_FILE, "use  SQL_DEFINITIONS;");
      NEW_LINE (DEFINITION_FILE);

      LINE := BLANK_CARD;

      INSERT_SLICE (LINE, "with ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, LAST_FUNCTIONAL_POS (LINE) + 2);
      INSERT_SLICE (LINE, "_UNDERLYING;", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);
      NEW_LINE (DEFINITION_FILE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "use ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 5);
      INSERT_SLICE (LINE, "_UNDERLYING;", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);
      NEW_LINE (DEFINITION_FILE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "package ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 9);
      INSERT_SLICE (LINE, "_DATABASE is ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);
      NEW_LINE (DEFINITION_FILE);

      GENERATE_TYPE_SUBTYPE_DECLARATIONS (DEFINITION_FILE);

      GENERATE_TABLE_SUBTYPE_DEFINITIONS (DEFINITION_FILE);

      GENERATE_FIELD_SUBTYPE_REDEFINITIONS (FIRST_FIELD_NODE, DEFINITION_FILE);

      GENERATE_TABLE_FUNCTION_REINSTANTIATIONS (DEFINITION_FILE);

      GENERATE_GET_FIELD_FUNCTION_INSTANTIATIONS (DEFINITION_FILE);

      GENERATE_INSERT_FIELD_FUNCTION_INSTANTIATIONS (DEFINITION_FILE);

      GENERATE_TABLE_PROCEDURE_REDEFINITIONS (DEFINITION_FILE);


      GENERATE_TABLE_FUNCTION_DECLARATIONS (DEFINITION_FILE);

      NEW_LINE (DEFINITION_FILE);
      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, " end ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 6);
      INSERT_SLICE (LINE, "_DATABASE", LAST_FUNCTIONAL_POS (LINE) + 1);
      INSERT_SLICE (LINE, "; ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);

      NEW_LINE (DEFINITION_FILE);
      PUT_LINE (DEFINITION_FILE, "with SQL_DEFINITIONS;");
      PUT_LINE (DEFINITION_FILE, "use  SQL_DEFINITIONS;");
      NEW_LINE (DEFINITION_FILE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "with ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 6);
      INSERT_SLICE (LINE, "_UNDERLYING;", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);

      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "use  ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 5);
      INSERT_SLICE (LINE, "_UNDERLYING;", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);

      NEW_LINE (DEFINITION_FILE);
      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, "package body ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 14);
      INSERT_SLICE (LINE, "_DATABASE is ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);
      NEW_LINE (DEFINITION_FILE);

      GENERATE_FUNCTION_BODY_DECLARATIONS (DEFINITION_FILE);

      NEW_LINE (DEFINITION_FILE);
      LINE := BLANK_CARD;
      INSERT_SLICE (LINE, " end ", 1);
      INSERT_SLICE (LINE, DATABASE_NAME, 6);
      INSERT_SLICE (LINE, "_DATABASE", LAST_FUNCTIONAL_POS (LINE) + 1);
      INSERT_SLICE (LINE, "; ", LAST_FUNCTIONAL_POS (LINE) + 1);
      PUT_LINE (DEFINITION_FILE, LINE);

    end CREATE_DATABASE_DEFINITIONS_FILE;

  begin

    CREATE_FIELD_LIST (FIRST_FIELD_NODE);

    PUT ("Input physical name of underlying package: ");

    GET_LINE (UNDERLYING_FILE_NAME, LENGTH);
    CREATE (UNDERLYING_FILE, OUT_FILE, UNDERLYING_FILE_NAME (1 .. LENGTH));

    NEW_LINE;

    CREATE_UNDERLYING_PACKAGE (FIRST_FIELD_NODE, DATABASE_NAME,
                   UNDERLYING_FILE);

    CLOSE (UNDERLYING_FILE);

    PUT ("Input physical name of database definitions package: ");

    GET_LINE (DEFINITION_FILE_NAME, LENGTH);
    CREATE (DEFINITION_FILE, OUT_FILE, DEFINITION_FILE_NAME (1 .. LENGTH));

    CREATE_DATABASE_DEFINITIONS_FILE
       (FIRST_FIELD_NODE, DATABASE_NAME, DEFINITION_FILE);

    CLOSE (DEFINITION_FILE);

    PUT_LINE ("End of Ada/SQL generator procedure.");

end GENERATE_SQL_DDL;


end SQL_DDL;
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--driver.ada
--::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
with READ_DDL;
 use READ_DDL;

with TOKEN_INPUT;
 use TOKEN_INPUT;

with SQL_DDL;
 use SQL_DDL;

with TEXT_IO;
 use TEXT_IO;

procedure DRIVER is

  INPUT        : INPUT_STREAM;
  PACKAGE_NAME : STRING (1..80);
  DDL_FILE     : STRING (1..80);
  LAST         : POSITIVE;
  LENGTH       : NATURAL;

begin

  INPUT := CREATE_STREAM (80);
  SET_STREAM (INPUT);
  PUT ("Input the name of the Ada DDL file: ");
  GET_LINE (DDL_FILE, LENGTH);
  OPEN_INPUT (INPUT, DDL_FILE (1..LENGTH));
  SCAN_DDL (PACKAGE_NAME, LAST);
  GENERATE_SQL_DDL (PACKAGE_NAME (1..LAST));
  CLOSE_INPUT (INPUT);

end DRIVER;