module Symbol_Table

  use Machine, only: IO_Error
  use String_Table, only: Allocate_Char_Table, Allocate_String_Table, &
                          Display_String, Add_Char, How_Many_Strings, &
                          Lookup_And_Insert, String_Table_Size
  use Symbol_Types, only: Caseless_Look, First_Type, &
                          Last_Type, T_Null, T_Last_Terminal, &
                          Term_Names, Term_Types, Type_Names
  use Output_m, only: Output
  use Toggles, only: Tab, Toggle

  implicit NONE
  private

  public :: ADD_TERMINAL, ALLOCATE_SYMBOL_TABLE, Class_Texts
  public :: DESTROY_SYMBOL_TABLE, DUMP_1_SYMBOL, DUMP_SYMBOL_CLASS
  public :: DUMP_SYMBOL_TABLE, DUMP_SYMBOL_TYPE, ENTER_TERMINAL
  public :: INIT_SYMBOL_TABLE, SET_SYMBOL, SYMBOL

  integer, save, protected :: CLASS_TEXTS(T_NULL: T_LAST_TERMINAL)
  integer, save, private, allocatable :: SYMBOLS(:)
  integer, save, private :: TYPE_TEXTS(FIRST_TYPE: LAST_TYPE) = 0

!---------------------------- RCS Module Info ------------------------------
  character (len=*), private, parameter :: ModuleName= &
       "$RCSfile: symbol_table.f90,v $"
  private :: not_used_here 
!---------------------------------------------------------------------------

contains
  ! =========================================     ADD_TERMINAL     =====
  integer function ADD_TERMINAL ( TERMINAL, DEBUG, CASESENSITIVE, Quotes )
  ! Add a terminal symbol with token index TERMINAL to the symbol table.
  ! Its text has already been entered into the string table by
  ! STRING_TABLE % ADD_CHAR.
    integer, intent(in) :: TERMINAL
    integer, optional, intent(in) :: DEBUG
    logical, optional, intent(in) :: CASESENSITIVE
    logical, optional, intent(in) :: Quotes ! Convert bound quotes to apostrophes

    integer :: WHERE
    logical :: FOUND
    integer :: myDEBUG
    logical :: myCASESENSITIVE
    
    myDEBUG = 0
    if ( present(DEBUG) ) myDEBUG = DEBUG

    myCaseSensitive = .not. caseless_look(terminal)
    if ( present ( caseSensitive ) ) myCaseSensitive = caseSensitive

    call lookup_and_insert ( where, found, .not. myCaseSensitive, DEBUG, quotes )
    if ( where > size(symbols) ) then
      call increase_symbols ! String table was expanded
    end if
    if ( .not. found ) then; symbols(where) = terminal; end if
    if ( toggle(tab) .OR. myDEBUG > 0 ) then
      call output ( 'Looked up ' ); call output ( terminal )
      call output ( ' ' ); call display_string ( where )
      if ( caseless_look(terminal) ) then; call output ( ' caseless' ); end if
      if ( found ) then
        call output ( ' and found it at ' )
      else
        call output ( ' and inserted it at ' )
      end if
      call output ( where )
      call output ( symbols(where), before=' with symbol ', advance='yes' )
    end if
    add_terminal = where
  end function ADD_TERMINAL
  ! ================================     ALLOCATE_SYMBOL_TABLE     =====
  subroutine ALLOCATE_SYMBOL_TABLE ( N_CHARS, N_SYMBOLS, STATUS, DEBUG )
  ! Allocate character, string and symbol tables.
  ! Also does INIT_SYMBOL_TABLE
    integer, intent(in) :: N_CHARS      ! Size of character table
    integer, intent(in) :: N_SYMBOLS    ! Size of string and symbol tables
    integer, intent(out), optional :: STATUS      ! from ALLOCATE
    integer, intent(in), optional :: DEBUG

    integer :: STAT
    if ( allocated(symbols) ) then; deallocate ( symbols ); end if
    call allocate_char_table ( n_chars, status )
    if ( present(status) ) then
      if ( status /= 0 ) then; return; end if
    end if
    call allocate_string_table ( n_symbols, status )
    if ( present(status) ) then
      if ( status /= 0 ) then; return; end if
    end if
    allocate ( symbols(n_symbols), stat=stat )
    if ( present(status) ) then
      status = stat
      if ( status /= 0 ) then; return; end if
    end if
    if ( stat /= 0 ) then
      call io_error &
      ( 'SYMBOL_TABLE%ALLOCATE_SYMBOL_TABLE-E- Unable to allocate storage', &
      stat, '' )
      stop
    end if
    call init_symbol_table ( debug )
  end subroutine ALLOCATE_SYMBOL_TABLE
  ! =================================     DESTROY_SYMBOL_TABLE     =====
  subroutine DESTROY_SYMBOL_TABLE ( Status )
    integer, intent(out), optional :: Status ! From deallocate
    if ( present(status) ) then
      deallocate ( symbols, stat=status )
    else
      deallocate ( symbols )
    end if
  end subroutine DESTROY_SYMBOL_TABLE
  ! ========================================     DUMP_1_SYMBOL     =====
  subroutine DUMP_1_SYMBOL ( SYMBOL, ADVANCE, BEFORE, ShowNumber, Strip )
  ! Print the symbol index, type and text.
    integer, intent(in) :: SYMBOL
    character(len=*), intent(in), optional :: ADVANCE
    character(len=*), intent(in), optional :: BEFORE
    logical, intent(in), optional :: ShowNumber
    logical, intent(in), optional :: Strip
    logical :: MyShow ! for ShowNumber
    myShow = .true. ! so as not to break old code
    if ( present(showNumber) ) myShow = showNumber
    if ( present(before) ) call output ( before )
    if ( myShow ) call output ( symbol, after=': ' )
    call display_string ( type_texts(term_types(symbols(symbol))) )
    call output ( ' ' )
    call display_string ( symbol, advance=advance, strip=strip )
  end subroutine DUMP_1_SYMBOL
  ! ====================================     DUMP_SYMBOL_CLASS     =====
  subroutine DUMP_SYMBOL_CLASS ( SYM_CLASS, ADVANCE )
  ! Print the symbol text, given its class, e.g. T_IDENTIFIER
    integer, intent(in) :: SYM_CLASS
    character(len=*), intent(in), optional :: ADVANCE
    call display_string ( class_texts(sym_class), advance )
  end subroutine DUMP_SYMBOL_CLASS
  ! ====================================     DUMP_SYMBOL_TABLE     =====
  subroutine DUMP_SYMBOL_TABLE
  ! Print the entire symbol table, using DUMP_1_SYMBOL
    integer :: I
    do i = 1, how_many_strings()
      call dump_1_symbol ( i, advance='yes' )
    end do
  end subroutine DUMP_SYMBOL_TABLE
  ! =====================================     DUMP_SYMBOL_TYPE     =====
  subroutine DUMP_SYMBOL_TYPE ( SYMTYP, ADVANCE )
  ! Print the symbol type, e.g. <reserved_word>.
    integer, intent(in) :: SYMTYP
    character(len=*), intent(in), optional :: ADVANCE
    call display_string ( type_texts(term_types(symbols(symtyp))), &
                          advance )
  end subroutine DUMP_SYMBOL_TYPE
  ! =======================================     ENTER_TERMINAL     =====
  integer function ENTER_TERMINAL ( TEXT, TERMINAL, DEBUG, CASESENSITIVE )
  ! Put the text of a terminal symbol at the end of the character table,
  ! then enter it and its terminal index into the symbol table.
    character(len=*), intent(in) :: TEXT
    integer, intent(in) :: TERMINAL
    integer, optional, intent(in) :: DEBUG
    logical, optional, intent(in) :: CASESENSITIVE
    call add_char ( text )
    enter_terminal = add_terminal ( terminal, DEBUG=DEBUG, CASESENSITIVE=CASESENSITIVE )
  end function ENTER_TERMINAL
  ! ====================================     INIT_SYMBOL_TABLE     =====
  subroutine INIT_SYMBOL_TABLE ( DEBUG )
  ! Initialize the symbol table, the table of string indices of terminal
  ! names, and the table of terminal type names.
    integer, intent(in), optional :: DEBUG
    logical :: FOUND          ! Argument for LOOKUP_AND_INSERT
    integer :: I              ! Loop inductor
    integer :: WHERE          ! Where was the symbol inserted?
    do i = t_null, t_last_terminal
      class_texts(i) = enter_terminal ( trim(term_names(i)), i, debug=debug )
    end do
    ! This loop puts token types into the string table.
    ! They're only used for debugging output.
    do i = first_type, last_type
      call add_char ( trim(type_names(i)) )
      call lookup_and_insert ( where, found, .false. )
      ! It's OK if it found one -- maybe it's a terminal text, too.
      if ( .not. found ) then; symbols(where) = t_null; end if
      type_texts(i) = where
    end do
    symbols(how_many_strings()+1:) = t_null
    if ( present(debug) ) then
      if ( debug > 0 ) call dump_symbol_table
    end if
  end subroutine INIT_SYMBOL_TABLE
  ! ===========================================     SET_SYMBOL     =====
  subroutine SET_SYMBOL ( STRING, CLASS )
  ! Set the class of the symbol at STRING to CLASS
    integer, intent(in) :: STRING
    integer, intent(in) :: CLASS
    if ( string > size(symbols) ) then
      call increase_symbols ! String table was expanded
    end if
    symbols(string) = class
  end subroutine SET_SYMBOL
  ! ===============================================     SYMBOL     =====
  integer function SYMBOL ( STRING )
  ! Return the symbol class of the STRING
    integer, intent(in) :: STRING
    if ( string > size(symbols) ) then
      call increase_symbols ! String table was expanded
    end if
    symbol = symbols(string)
  end function SYMBOL

! =====     Private procedures    ======================================
  ! -------------------------------------     INCREASE_SYMBOLS     -----
  subroutine INCREASE_SYMBOLS ( STAT )
  ! Increase the upper bound for the symbol table to the upper bound of
  ! the string table.
    integer, optional, intent(out) :: STAT
    integer :: MY_STAT
    integer, allocatable :: New_Symbol(:)
    allocate( new_symbol(string_table_size()), stat=my_stat )
    if ( my_stat /= 0 ) then
      if ( present(stat) ) then
        stat = my_stat
        return
      end if
      call io_error &
      ( 'SYMBOL_TABLE%INCREASE_SYMBOLS-E- Unable to allocate storage', &
      stat, '' )
      stop
    end if
    new_symbol(:size(symbols)) = symbols
    new_symbol(size(symbols)+1) = t_null
    call move_alloc ( new_symbol, symbols )
  end subroutine INCREASE_SYMBOLS

!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: symbol_table.f90,v 1.2 2022/01/27 02:08:32 vsnyder Exp $"
  character (len=len(idParm)) :: Id = idParm
    not_used_here = (id(1:1) == ModuleName(1:1))
    print *, Id ! .mod files sometimes change if PRINT is added
  end function not_used_here
!---------------------------------------------------------------------------

end module SymboL_Table

! $Log: symbol_table.f90,v $
! Revision 1.2  2022/01/27 02:08:32  vsnyder
! Incorporate the only executable statements in Init_Terminal and Init_Type
! into Init_Symbol_Table in the Symbol_Table module
!
! Revision 1.1  2022/01/24 22:22:18  vsnyder
! Initial commit
!
