module Lexer_m

! Example lexer to use table generated by Lex.

  use DFA_Defs, only: Skip, Previous ! Edge modifiers
  use ISO_Fortran_Env, only: EU => Error_Unit
  use Lexer_Actions_m, only: DFA, DFA_2d, Classes, Do_Action
  use Lexer_Core, only: Need, Print_Source, Token
  use Output_m, only: NewLine, Output
  use String_Table, only: Add_Char, Delete_Char, EOF, EOL, Get_Char, &
                        & Include_Stack_Top, Source_Column, Source_Line
  use Symbol_Table, only: Dump_1_Symbol
  use Toggles, only: Levels, Lex, Toggle

  implicit NONE

  private

  public :: Lexer

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

contains

  ! ------------------------------------------------------  Lexer  -----
  subroutine Lexer (  The_Token )
    type(token), intent(out) :: The_Token

    character, save :: Ch          ! Current character
    integer :: Class               ! Classification of current character
    integer :: File                ! String index from include stack
    logical :: Kept                ! .not. Need, for printing the state trace
    integer :: Modifier            ! Modifier for "What" = mod(DFA_2d(...),10)
    integer :: Source_Start        ! Source reference for start of token
                                   ! ( 256*line + column )
    integer :: State               ! Current state of lexer DFA
    integer :: What                ! Action from the DFA table

    call include_stack_top ( file )

    state = 1
    do
      kept = .not. need
      if ( need ) call get_char ( ch )
      need = .false.
      ! Classify the character
      class = iachar(ch)
      if ( class >= lbound(classes,1) .and. class <= ubound(classes,1) ) then
        class = classes(class)
      else
        class = 0 ! The "unknown character" row of DFA_2d
      end if

      what = DFA_2d(class,state)
      modifier = mod(abs(what),10)
      if ( levels(lex) > 0 ) call state_trace ( class, state )
      if ( state == 1 ) source_start = 256 * source_line + source_column

      if ( what <= 0 ) then ! Assume do_action handles "no action" errors
        need = need .and. modifier == 0 .or. what == 0
        if ( do_action ( -what / 10, ch, source_start, the_token ) ) exit ! created a token?
        state = 1
      else
        select case ( modifier )
        case ( skip )     ! Delete current char, usually to delete
                          ! a quote or apostrophe within a string in which
                          ! the bounding quotes and apostrophes are excluded
        ! Just don't add it to the string
        case ( previous ) ! Delete the previous char, usually to delete
                          ! a quote or apostrophe within a string in which
                          ! the bounding quotes and apostrophes are included
          call delete_char     ! Delete the last character
          call add_char ( ch ) ! Add the current character
        case default
          call add_char ( ch ) ! Add the current character
        end select
        state = what / 10
        if ( state > size(DFA_2d,2) ) then
          write ( eu, '(*(a,i0))' ) 'DFA_2d is broken. DFA_2d(',state,',',class, &
                                 & ') / 10 is out of the range of the states.'
          error stop 1
        end if
        need = .true.
      end if
    end do

    if ( toggle(lex) ) then
      call dump_1_symbol ( the_token%string_index )
      call print_source ( the_token%where, before = ' at ', advance='yes' )
    end if

  contains

    character(:) function Show_Ch ( Ch )
      character, intent(in) :: Ch
      allocatable :: Show_Ch
      if ( ch == EOL ) then
        show_ch = 'EOL'
      else if ( ch == EOF ) then
        show_ch = 'EOF'
      else
        show_ch = ch
      end if
    end function Show_Ch

    subroutine State_Trace ( Class, State )
      integer, intent(in) :: Class, State
      call output ( state, before='State = ' )
      if ( kept) call output ( ' kept' )
      call output ( ' Ch = ' )
      call output ( show_ch(ch) )
      call output ( source_line, before=' Line = ' )
      call output ( source_column, before=' Column = ' )
      call output ( class, before=' Class = ' )
      call output ( ' = ' )
      call output ( trim(dfa%class_names(class)) )
      if ( what < 0 ) then       ! Action
        call output ( ' action ' )
        call output ( -what/10, after=' ' )
        call output ( trim(dfa%action_names(-what/10)) )
        if ( mod(what,10) /= 0 ) call output ( ' keep')
      else if ( what == 0 ) then ! Error
        call output ( 'Error' )
      else                                    ! Transition
        call output ( what / 10, before=' -> ' )
        select case ( modifier )
        case ( skip )     ! Delete current character
          call output ( '^' )
        case ( previous ) ! Delete previous character
          call output ( '-' )
        end select
      end if
      call newLine
    end subroutine State_Trace

  end subroutine Lexer

!--------------------------- end bloc --------------------------------------
  logical function not_used_here()
  character (len=*), parameter :: IdParm = &
       "$Id: Lexer_m.f90,v 1.1 2022/01/24 22:05:49 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_m


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