-- -- Author: Robert C. Shock, Dept of CS & CEG Wright State University -- In cooperation with: WRDC/ELED WPAFB Dayton, OH -- with io_unit; with vhdl_name; with vhdl_build; with text_io; package body vhdl_lexicon is package element_type_io is new text_io.enumeration_io ( element_type ); package element_subtype_io is new text_io.enumeration_io ( element_subtype ); package element_name_io is new text_io.enumeration_io ( element_name ); g_element_type: element_type := comment; function value_is return string is the_look_ahead_1: character := ( io_unit.next_character_is ); the_look_ahead_2: character := ( ' ' ); the_look_ahead_3: character := ( ' ' ); begin case the_look_ahead_1 is -- UNAMBIGUOUS CASES: ie, the first character identifies uniquely a lexical element when '0' .. '9' => -- ABSTRACT LITERAL io_unit.push_back ( the_look_ahead_1 ); g_element_type := abstract_literal; return vhdl_build.value_abstract_literal_is; when '"' => -- STRING LITERAL io_unit.push_back ( the_look_ahead_1 ); g_element_type := string_literal; return vhdl_build.value_string_literal_is; when 'a' | 'c' .. 'n' | 'p' .. 'w' | 'y' .. 'z' | 'A' | 'C' .. 'N' | 'P' .. 'W' | 'Y' .. 'Z' => -- IDENTIFIER io_unit.push_back ( the_look_ahead_1 ); g_element_type := identifier; return vhdl_build.value_identifier_is; when '&' | '(' .. ',' | '.' | '/' | ':' .. '>' | '|' => -- DELIMITER io_unit.push_back ( the_look_ahead_1 ); g_element_type := delimiter; return vhdl_build.value_delimiter_is; -- AMBIGUOUS CASES: ie, requires more than one look ahead character when '-' => -- COMMENT or DELIMITER hyphen the_look_ahead_2 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 = '-' then -- comment g_element_type := comment; return vhdl_build.value_comment_is; else -- delimiter g_element_type := delimiter; return vhdl_build.value_delimiter_is; end if; when 'B' | 'b' | 'O' | 'o' | 'X' | 'x' => -- IDENTIFIER or BIT_STRING_LITERAL the_look_ahead_2 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 = '"' then -- bit_string_literal g_element_type := bit_string_literal; return vhdl_build.value_bit_string_literal_is; else -- identifier g_element_type := identifier; return vhdl_build.value_identifier_is; end if; when ''' => -- CHARACTER LITERAL or DELIMITER apostrophe the_look_ahead_2 := io_unit.next_character_is; the_look_ahead_3 := io_unit.next_character_is; io_unit.push_back ( the_look_ahead_3 ); io_unit.push_back ( the_look_ahead_2 ); io_unit.push_back ( the_look_ahead_1 ); if the_look_ahead_2 /= the_end_line_character and then the_look_ahead_3 = ''' then -- it is a character_literal g_element_type := character_literal; return vhdl_build.value_character_literal_is; else -- it is a delimiter g_element_type := delimiter; return vhdl_build.value_delimiter_is; end if; when the_end_file_character | the_end_page_character | the_end_line_character | ascii.ht | ' ' => -- SEPARATORS io_unit.push_back ( the_look_ahead_1 ); g_element_type := separator; return vhdl_build.value_separator_is; when others => -- check first for other separators if the_look_ahead_1 = ascii.cr or the_look_ahead_1 = ascii.lf or the_look_ahead_1 = ascii.ff or the_look_ahead_1 = ascii.vt then -- the character is an effector, valid vhdl syntax io_unit.push_back ( the_look_ahead_1 ); g_element_type := separator; return vhdl_build.value_separator_is; else -- invalid vhdl syntax io_unit.push_back ( the_look_ahead_1 ); g_element_type := comment; return "--* " & vhdl_build.value_comment_is; end if; end case; end value_is; function type_is return element_type is begin return g_element_type; end type_is; function subtype_is return element_subtype is begin return vhdl_build.lexicon_subtype_is; end subtype_is; function name_is return element_name is begin return vhdl_build.lexical_name_is; end name_is; ---- OUTPUT IO ---- procedure put ( the_string: in string ) is begin io_unit.put ( the_string ); end put; procedure put ( the_element_type: in element_type; the_field_width: in text_io.field := 18; -- 18 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is begin element_type_io.put ( the_element_type, the_field_width, the_type_set ); end put; procedure put ( the_element_subtype: in element_subtype; the_field_width: in text_io.field := 25; -- 25 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is begin element_subtype_io.put ( the_element_subtype, the_field_width, the_type_set ); end put; procedure put ( the_element_name: in element_name; the_field_width: in text_io.field := 28; -- 28 characters in largest type the_type_set: in text_io.type_set := text_io.lower_case ) is -- the problem: reserved words ( end ) is not allowed to be a value in an enumerated type 'element_name'; end is represented as 'end_id' in 'element_name'. -- Hence, when the last three characters = "_id", remove them. the_length: natural := element_name'image ( the_element_name )'length; the_value: string ( 1 .. the_length ); begin element_name_io.put ( to => the_value ( 1 .. the_length ), item => the_element_name, set => the_type_set ); if the_value'length > 3 then if ( the_value ( the_value'last - 2 .. the_value'last ) = "_id" or the_value ( the_value'last - 2 .. the_value'last ) = "_ID" ) then the_length := the_length - 3; end if; end if; if the_field_width = 0 then text_io.put ( the_value ( 1 .. the_length ) ); elsif the_field_width < the_length then text_io.put ( the_value ( 1 .. the_field_width ) ); else text_io.put ( the_value ( 1 .. the_length) & ( the_length + 1 .. the_field_width => ' ' ) ); end if; end put; procedure iterate_vhdl_code is continue: boolean := false; the_subtype: element_subtype := separator_end_of_file; procedure execute_the_function_value_is ( the_value: in string ) is begin the_subtype := subtype_is; process ( the_value, type_is, the_subtype, name_is, continue ); end execute_the_function_value_is; begin iterate: loop execute_the_function_value_is ( value_is ); exit iterate when not continue or the_subtype = separator_end_of_file; end loop iterate; end iterate_vhdl_code; procedure iterate_vhdl_code_with_parameters ( the_external_data_in: in external_type_in; the_external_data_in_out: in out external_type_in_out ) is continue: boolean := false; the_subtype: element_subtype := separator_end_of_line; procedure execute_the_function_value_is ( the_value: in string ) is begin the_subtype := subtype_is; process ( the_external_data_in, the_external_data_in_out, the_value, type_is, the_subtype, name_is, continue ); end execute_the_function_value_is; begin iterate: loop execute_the_function_value_is ( value_is ); exit iterate when not continue or the_subtype = separator_end_of_file; end loop iterate; end iterate_vhdl_code_with_parameters; end vhdl_lexicon;