--
-- Author:  Robert C. Shock,  Dept of CS & CEG   Wright State University
-- In cooperation with:  WRDC/ELED WPAFB   Dayton, OH
--
-- source: vhdl_build__.a
                     

with vhdl_name;
with vhdl_lexicon;
with io_unit;


package body vhdl_build is


function "=" ( the_left: in vhdl_lexicon.element_name; the_right: in vhdl_lexicon.element_name ) return boolean renames vhdl_lexicon."=";

type body_values is array ( character ) of boolean;
         
   -- CONSTANTS 

identifier_unit_body: constant body_values := body_values'
   ( 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' => true, others => false);

   
string_body: constant body_values := body_values' 
   ( '"' | io_unit.the_end_line_character => false, 
others => true );


comment_unit_body: constant body_values := body_values' 
   ( io_unit.the_end_line_character => false, others => true );


digit_unit_body: constant body_values := body_values' 
   ( '0' .. '9' | '_' => true, others => false);


-- GLOBAL OBJECTS

g_lexicon_element_subtype: vhdl_lexicon.element_subtype := vhdl_lexicon.separator_end_of_line;
g_lexical_name: vhdl_lexicon.element_name := vhdl_lexicon.space_character;


   -- CONSTRUCTORS

function construct ( from_the_lexical_body: in body_values ) return string is
   -- Effect: calls io_unit.next_character to construct a lexical element defined by 'from_the_lexical_body'. 
-- Note, after a call to construct, a call to 'io.next_character_is' points the first character following this lexical element

   function data return string is
the_string: string ( 1 .. 1 ) := ( others => ' ' );
   begin
the_string ( 1 ) := io_unit.next_character_is;
   if from_the_lexical_body ( the_string ( 1 ) ) then
      return the_string & data; 
   else
      io_unit.push_back ( the_string ( 1 ) ); 
      return "";
   end if;
   end data;

begin
return data;
end construct;



function value_identifier_is return string is 

   function value_is ( the_value: in string ) return string is 
   begin
   if vhdl_name.is_reserve_word ( the_value ) then
      g_lexicon_element_subtype := vhdl_lexicon.identifier_reserved; 
      g_lexical_name := vhdl_name.reserve_word_name_is;
   else
      g_lexicon_element_subtype := vhdl_lexicon.identifier_not_reserved; 
      g_lexical_name := vhdl_lexicon.identifier_not_rw_id;
   end if;   
   return the_value;
   end value_is;
begin
return value_is ( construct ( from_the_lexical_body =>identifier_unit_body ));
end value_identifier_is;


function value_separator_is return string is 
   the_string: string ( 1 .. 1 ) := ( others => io_unit.next_character_is );
begin
if vhdl_name.is_separator ( the_string ( 1 ) ) then
   g_lexical_name := vhdl_name.separator_name_is;
   if g_lexical_name = vhdl_lexicon.line_feed then
      g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_line;
   elsif g_lexical_name = vhdl_lexicon.form_feed then
   g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_page;
   elsif g_lexical_name = vhdl_lexicon.end_file then
      g_lexicon_element_subtype := vhdl_lexicon.separator_end_of_file; 
   else
      g_lexicon_element_subtype := vhdl_lexicon.separator_format_effector; 
   end if;
end if;
return the_string;
end value_separator_is;


function value_delimiter_is return string is 
   the_string: string ( 1 .. 2 ) := ( others => ' ' ); 
begin
the_string ( 1 ) := io_unit.next_character_is;
the_string ( 2 ) := io_unit.next_character_is;
if vhdl_name.is_compound_delimiter ( the_string ) then
   g_lexicon_element_subtype := vhdl_lexicon.delimiter_double; 
   g_lexical_name := vhdl_name.compound_delimiter_name_is;
   return the_string;
elsif vhdl_name.is_single_delimiter ( the_string ( 1 ) ) then 
   g_lexicon_element_subtype := vhdl_lexicon.delimiter_single; 
   g_lexical_name := vhdl_name.single_delimiter_name_is;
   io_unit.push_back ( the_string ( 2 ) ); -- last character, not in delimiter_body 
   return the_string ( 1 .. 1 );
end if;
end value_delimiter_is;




function value_character_literal_is return string is 
   the_value: string ( 1 .. 3 ) := ( others => ' ' );
begin
the_value ( 1 ) := io_unit.next_character_is;
the_value ( 2 ) := io_unit.next_character_is;
the_value ( 3 ) := io_unit.next_character_is;
g_lexicon_element_subtype := vhdl_lexicon.literal_character; 
g_lexical_name := vhdl_lexicon.character_literal;
return the_value;
end value_character_literal_is;




function value_abstract_literal_is return string is 

   -- 
   function exponent_is ( the_current_value: in string ) return string is
      the_look_ahead: string ( 1 .. 2 ) := ( others => ' ' );

   begin
   the_look_ahead ( 1 ) := io_unit.next_character_is;
   if the_look_ahead ( 1 ) = 'E' or the_look_ahead ( 1 ) = 'e' then
      the_look_ahead ( 2 ) := io_unit.next_character_is;
      return the_current_value & the_look_ahead &   
         construct ( from_the_lexical_body => digit_unit_body );
   else
      io_unit.push_back ( the_look_ahead ( 1 ) );
      return the_current_value;
   end if;
   end exponent_is;   

   --
   function value_is ( the_integer: in string ) return string is 
      the_look_ahead: character := io_unit.next_character_is;

   begin -- value_is
   case the_look_ahead is
   when '.' =>
      g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; 
      g_lexical_name := vhdl_lexicon.real_literal;
      return exponent_is ( 
the_integer & 
( '.' ) &
      construct ( from_the_lexical_body => digit_unit_body ) );


   when 'E' | 'e' =>
      g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; 
      g_lexical_name := vhdl_lexicon.integer_exponent_literal;
      io_unit.push_back ( the_look_ahead );
      return exponent_is ( the_integer );


when '#' => 
      based_literal_code:
      declare   
         based_integer_extended: constant body_values := body_values' 
             ( 'a' .. 'f' | 'A' .. 'F' | '0' .. '9' | '.' | '_' => true, others => false );
      function extend ( the_string: in string ) return string is
         the_string_1: string ( 1 .. 1 ) := ( others => ' ' );
      begin
the_string_1 ( 1 ) := io_unit.next_character_is;
      return exponent_is ( the_string & the_string_1 );
      end extend;

      begin
      g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_based; 
      g_lexical_name := vhdl_lexicon.based_literal;
      return extend ( the_integer & ( the_look_ahead ) &
         construct ( based_integer_extended ) );
      end
      based_literal_code;

   when others =>
      g_lexicon_element_subtype := vhdl_lexicon.literal_abstract_decimal; 
      g_lexical_name := vhdl_lexicon.integer_literal;
      io_unit.push_back ( the_look_ahead );
      return the_integer; 

   end case;
   end value_is;

begin
return value_is ( construct ( from_the_lexical_body => digit_unit_body ) );
end value_abstract_literal_is;


function value_string_literal_is return string is 
   the_string_1: string ( 1 .. 1 ) := ( 1 => io_unit.next_character_is );

   function build_the_string ( the_value: in string ) return string is
      the_look_ahead_string: string ( 1 .. 2 ) := ( others => ' ' );
   begin
   the_look_ahead_string ( 1 ) := io_unit.next_character_is;
   the_look_ahead_string ( 2 ) := io_unit.next_character_is;
   if the_look_ahead_string ( 2 ) = '"' then -- special case of double quots 
      return the_value & 
the_look_ahead_string & 
build_the_string ( construct ( from_the_lexical_body => string_body ) );
   elsif the_look_ahead_string ( 1 ) = '"' then -- standard comment line 
      io_unit.push_back ( the_look_ahead_string ( 2 ) );
      return the_value & the_look_ahead_string ( 1 .. 1 );

else -- case of error
      io_unit.push_back ( the_look_ahead_string ( 2 ) );
      io_unit.push_back ( the_look_ahead_string ( 1 ) );
return the_value & " -- E R R O R""";

   end if;
   end build_the_string;

begin
g_lexicon_element_subtype := vhdl_lexicon.literal_string; 
g_lexical_name := vhdl_lexicon.string_literal;
return the_string_1 & build_the_string ( construct ( from_the_lexical_body => string_body ) );
end value_string_literal_is;



function value_bit_string_literal_is return string is
   the_look_ahead: string ( 1 .. 2 ) := ( others => ' ' );
begin
the_look_ahead ( 1 ) := io_unit.next_character_is;
the_look_ahead ( 2 ) := io_unit.next_character_is;
g_lexicon_element_subtype := vhdl_lexicon.literal_bit_string; 
g_lexical_name := vhdl_lexicon.bit_string_B;
if the_look_ahead ( 1 ) = 'o' or the_look_ahead ( 1 ) = 'O' then
   g_lexical_name := vhdl_lexicon.bit_string_O;
elsif the_look_ahead ( 1 ) = 'x' or the_look_ahead ( 1 ) = 'X' then
   g_lexical_name := vhdl_lexicon.bit_string_X;
end if;
-- add to make correct
return 
   the_look_ahead &
   construct ( from_the_lexical_body => string_body ) & 
   ( io_unit.next_character_is ); -- must be '"'
end value_bit_string_literal_is;


function value_comment_is return string is 
begin
g_lexicon_element_subtype := vhdl_lexicon.comment; 
g_lexical_name := vhdl_lexicon.comment;
return  
   construct ( from_the_lexical_body => comment_unit_body );
end value_comment_is;


function lexicon_subtype_is return vhdl_lexicon.element_subtype is 
begin
return g_lexicon_element_subtype;
end lexicon_subtype_is;


function lexical_name_is return vhdl_lexicon.element_name is
begin
return g_lexical_name;
end lexical_name_is;

end vhdl_build;