module lexer_core

! Provides the token type and the initialization routine used by all
! lexers, and a routine to print the source text line and column number.

  use Lexer_Types, only: Token, Where_T
  implicit none
  private
  public :: Get_Where, need, token, init_lexer, print_source, where_t

  logical, save :: NEED = .true.   ! "Lexer needs to read a character"

  interface Get_Where
    module procedure Get_Where_Integer, Get_Where_Where
  end interface

  interface Print_Source
    module procedure Print_Source_Integer, Print_Source_Where
  end interface

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

contains

  subroutine INIT_LEXER ( N_CHARS, N_SYMBOLS, HASH_TABLE_SIZE, STAT, DEBUG )
  ! Allocate the character, symbol and hash tables, which automatically
  ! initializes them.
    use String_table, only: allocate_hash_table, init_string_table
    use Symbol_table, only: allocate_symbol_table
    use Toggles, only: init_toggle

    integer, intent(in) :: N_CHARS      ! Initial size of character table
    integer, intent(in) :: N_SYMBOLS    ! Initial sizes of string and
                                        ! symbol tables
    integer, intent(in) :: HASH_TABLE_SIZE   ! Duh
    integer, intent(out), optional :: STAT   ! Status from a called routine
    integer, intent(in), optional :: DEBUG
    integer :: MY_STAT

    ! Since Lexer is the one using get_char subroutine,
    ! which uses the variables being initialize in
    ! init_string_table, init_string_table may as well
    ! be called here
    call init_string_table

    call allocate_hash_table ( hash_table_size, my_stat )
    if ( my_stat == 0 ) &
      call allocate_symbol_table ( n_chars, n_symbols, my_stat, debug )
    if ( my_stat == 0 ) call init_toggle
    need = .true.
    if ( present(stat) ) stat = my_stat
  end subroutine INIT_LEXER

  subroutine Get_Where_Integer ( Where, Text, File, Before, After )
    use String_Table, only: Get_String
    integer, intent(in) :: Where
    character(len=*), intent(out) :: Text
    integer, intent(in), optional :: File
    character(len=*), intent(in), optional :: Before, After
    integer :: L
    l = 1
    if ( present(before) ) then
      text = before
      l = len(before) + 1
    end if
    write ( text(l:), 1 ) where/256, mod(where,256)
  1 format ( 'line ', i0, ', column ', i0 )
    if ( present(file) ) then
      if ( file > 0 ) then
        l = len_trim(text) + 1
        text(l:l+3) = ' in '
        call get_string ( file, text(l+4:) )
      end if
    end if
    if ( present(after) ) then
      l = len_trim(text) + 1
      text(l:) = after
    end if
  end subroutine Get_Where_Integer

  subroutine Get_Where_Where ( Where, Text, Before, After  )
    type(where_t), intent(in) :: Where
    character(len=*), intent(out) :: Text
    character(len=*), intent(in), optional :: Before, After
    call get_where ( where%source, text, where%file, before, after )
  end subroutine Get_Where_Where

  subroutine PRINT_SOURCE_INTEGER ( SOURCE, ADVANCE, BEFORE, After, File )
  ! Output "line LLL, column CCC"
    use String_Table, only: Display_String
    use OUTPUT_M, only: NewLine, OUTPUT

    integer, intent(in) :: SOURCE  ! 256*srcLine + srcCol
    character(len=*), intent(in), optional :: ADVANCE
    character(len=*), intent(in), optional :: BEFORE, After
    integer, intent(in), optional :: File ! From include stack
    logical :: MyAdv
    myAdv = .false.
    if ( present(advance) ) then
      ! This kludge is necessary because "call output ( '', advance=advance )
      ! outputs one blank character, instead of zero.
      myAdv = advance(1:1) == 'y' .or. advance(1:1) == 'Y'
    end if
    if ( present(before) ) call output ( before )
    call output ( source/256 , before='line ' )
    call output ( mod(source,256), before=', column ' )
    if ( present(file) ) then
      if ( file /= 0 ) call display_string ( file, before=' in ', strip=.true. )
    end if
    if ( present(after) ) call output ( after )
    if ( myAdv ) call newLine
  end subroutine PRINT_SOURCE_INTEGER

  subroutine Print_Source_Where ( Where, Advance, Before, After )
    type(where_t), intent(in) :: Where
    character(len=*), intent(in), optional :: ADVANCE
    character(len=*), intent(in), optional :: BEFORE, After
    call print_source ( where%source, advance, before, after, where%file )
  end subroutine Print_Source_Where
    
!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: lexer_core.f90,v 1.1 2022/01/24 22:05:24 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 lexer_core

! $Log: lexer_core.f90,v $
! Revision 1.1  2022/01/24 22:05:24  vsnyder
! Initial commit
!
