module Lexer_Actions_m

  use DFA_Defs, only: DFA_t, Skip_Ch => Skip, Previous
  use Error_Handler, only: Error_Walkback
  use Lexer_Core, only: Print_Source, Token, Where_t
  use Make_LD_Table_m, only: Make_LD_Table
  use Output_m, only: NewLine, Output
  use String_Table, only: Clear_String, Display_String, Include_Stack_Top, &
                        & Lookup_and_Insert, Source_Column, Source_Line
  use Symbol_Table, only: Add_Terminal, Class_Texts, Dump_1_Symbol, Set_Symbol, &
                        & Symbol
  use Symbol_Types, only: Caseless_Look, T_Null, T_Unclassified, T_Junk, &
                        & T_Incomplete,  T_End_Of_Input, T_EOS, &
                        & T_Coord, T_Identifier, T_Number, T_String, &
                        & T_Unk_Op, T_Unk_Pun
  use Toggles, only: Levels, Lex

  implicit NONE
  public

  ! Include file generated by Lex. Defines Class_Names, Action_Names, and DFA
  include 'Lexer_Table.f9h'

  ! Classify ASCII characters
  ! EOF and EOL should be the same as in String_Table
  integer, parameter :: CLASSES(0:127) = (/ &
! NUL     SOH     STX     ETX     EOT=^D  ENQ     ACK      BEL
  more,   more,   more,   more,   EOF,    more,   more,    more,     & ! 000
! BS      HT      LF=^J   VT      FF      CR=^M   SO       SI
  more,   blank,  EOL,    more,   more,   EOL,    more,    more,     & ! 010
! DLE     DC1     DC2     DC3     DC4     NAK     SYN      ETB
  more,   more,   more,   more,   more,   more,   more,    more,     & ! 020
! CAN     EM      SUB     ESC     FS      GS      RS       US
  more,   more,   more,   more,   more,   more,   more,    more,     & ! 030
! SPACE   !       "       #       $       %       &        '
  blank,  more,   quote,  more,   cont,   more,   cont,    apost,    & ! 040
! (       )       *       +       ,       -       .        /
  pun_ch, pun_ch, pun_ch, pun_ch, pun_ch, pun_ch, dot,     op_ch,    & ! 050
! 0       1       2       3       4       5       6        7
  digit,  digit,  digit,  digit,  digit,  digit,  digit,   digit,    & ! 060
! 8       9       :       ;       <       =       >        ?
  digit,  digit,  pun_ch, cmt,    op_ch,  pun_ch, op_ch,   op_ch,    & ! 070
! @       A       B       C       D       E       F        G
  more,   letter, letter, letter, letter, letter, letter,  letter,   & ! 100
! H       I       J       K       L       M       N        O
  letter, letter, letter, letter, letter, letter, letter,  letter,   & ! 110
! P       Q       R       S       T       U       V        W
  letter, letter, letter, letter, letter, letter, letter,  letter,   & ! 120
! X       Y       Z       [       \       ]       ^        _
  letter, letter, letter, pun_ch, more,   pun_ch, op_ch,   under,    & ! 130
! `       a       b       c       d       e       f        g
  more,   letter, letter, letter, letter, letter, letter,  letter,   & ! 140
! h       i       j       k       l       m       n        o
  letter, letter, letter, letter, letter, letter, letter,  letter,   & ! 150
! p       q       r       s       t       u       v        w
  letter, letter, letter, letter, letter, letter, letter,  letter,   & ! 160
! x       y       z       {       |       }       ~        DEL
  letter, letter, letter, pun_ch, op_ch,  pun_ch, pun_ch,  more   /)   ! 170

  integer, allocatable, save :: DFA_2d(:,:) ! DFA table

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

contains

  subroutine Make_DFA_2D
    call make_ld_table ( DFA, DFA_2d )
  end subroutine Make_DFA_2D

  logical function Do_Action ( Action, Ch, Source_Start, The_Token )
    ! Do an action indicated by the DFA. The result is true if a token is
    ! created. If the accumulated string is discarded, for example for a
    ! comment or statement continuation, and the DFA should restart, the
    ! result is false.
    integer, intent(in) :: Action
    character, intent(in) :: Ch   ! Current character in case it's needed
                                  ! for an error message
    integer, intent(in) :: Source_Start ! Token start ( 256*line + column )
    type(token), intent(out) :: The_Token

    integer :: File               ! String index from include stack
    logical :: Found              ! by Lookup_and_Insert
    integer :: String_Index

    ! Jobs for lexer actions to do
    enum, bind(c) ! BIND(C) is required, but this isn't for interoperability
      enumerator :: Gen_Token  ! Generate a token
      enumerator :: Enter      ! Enter into the string table
      enumerator :: Gen_Error  ! Generate an error token
      enumerator :: Gen_Op_Pun ! Look up an operator or punctuator
      enumerator :: Discard    ! Delete accumulated text and restart
      enumerator :: Quotes     ! Enter string with bounding quotes -> apostrophes
    end enum

    character(*), parameter :: Job_Names(gen_token:quotes) = [ &
    & 'Gen_Token ', &
    & 'Enter     ', &
    & 'Gen_Error ', &
    & 'Gen_Op_Pun', &
    & 'Discard   ', &
    & 'Quotes    ' ]

    ! Actions
    type :: Action_t
      integer :: What  ! Set a toggle, generate a token, lookup an identifier
      integer :: Term  ! Terminal token index
    end type Action_t

    ! The zero'th one MUST BE for the "zero action" case, which is NOT generated
    ! by Lex -- so as not to reserve an action name.
    ! The rest MUST BE in the same order as in the definition of vertex action
    ! labels in the included generated table!
    ! Or you could use DATA statements and explicit subscripts, which risks
    ! omitting some.
    type(action_t), parameter :: Action_Table(0:last_action) = [ &
      !        What        Term
      action_t(gen_error,  t_unclassified), & ! Unclassified character
      action_t(gen_error,  t_junk),         & ! BadCont
      action_t(enter,      t_coord),        & ! Coordinate digit letter
      action_t(gen_token,  t_end_of_input), & ! End_of_file
      action_t(gen_token,  t_eos),          & ! End_of_line
      action_t(enter,      t_identifier),   & ! Identifier
      action_t(gen_error,  t_incomplete),   & ! Incomplete
      action_t(enter,      t_number),       & ! Integer
      action_t(gen_op_pun, t_unk_op ),      & ! Operator
      action_t(gen_op_pun, t_unk_pun ),     & ! Punctuator
      action_t(discard,    0),              & ! Skip
      action_t(quotes,     t_string)        ] ! String

    call include_stack_top ( file ) ! Name of the file from which the token
                                    ! is being read, for tracing and errors

    if ( levels(lex) > 0 ) then
      call output ( 'Action for ' )
      if ( action == 0 ) then
        call output ( 'unclassified' )
      else
        call output ( trim(dfa%action_names(action)) )
      end if
      call print_source ( 256*source_line+source_column, before=' at ' )
      call output ( ' is ' )
      call output ( trim(job_names(action_table(action)%what)) )
      if ( action_table(action)%term /= 0 ) then
        call output ( ' and generate ' )
        call dump_1_symbol ( action_table(action)%term )
      end if
      call newLine
    end if

    do_action = .true. ! Assume a token will be generated
    select case ( action_table(action)%what )
    case ( discard )
      call clear_string
      do_action = .false.
    case ( enter, quotes ) ! Pseudo terminals
      call lookup_and_insert ( string_index, found, &
                             & caseless_look(action_table(action)%term), &
                             & quotes = action_table(action)%what==quotes )
      ! If the symbol type is "Object" it was inserted from the parser table
      ! with an unknown type. Set it now.
      if ( .not. found .or. symbol(string_index) == t_null ) &
        & call set_symbol ( string_index, action_table(action)%term )
      the_token = token( symbol(string_index), string_index, .true., &
                         where_t(file, source_start) )
    case ( gen_error, gen_token )
      call clear_string
      the_token = token ( action_table(action)%term, &
                        & class_texts(action_table(action)%term), .false., &
                        & where_t(file, source_start) )
      if ( action_table(action)%what == gen_error ) then
        call error ( action_table(action)%term )
      end if
    case ( gen_op_pun )
      call lookup_and_insert ( string_index, found )
      ! If the symbol type is "Object" it was inserted from the parser table
      ! with an unknown type. Set it now.
      if ( .not. found .or. symbol(string_index) == t_null ) &
        & call set_symbol ( string_index, action_table(action)%term )
      the_token = token( symbol(string_index), string_index, .false., &
                         where_t(file, source_start) )
      if ( .not. found )  call error ( action_table(action)%term )
    end select

  contains

    subroutine Error ( Code )
      integer, intent(in) :: Code ! Error code

      if ( file /= 0 ) then
        call display_string ( file, before=' in ' )
        call output ( source_line, before=' at line ' )
      else
        call output ( source_line, after=': ' )
      end if
      select case ( code )
      case ( t_incomplete )
        call output ( 'Incomplete string' )
      case ( t_junk )
        call output ( 'Junk after continuation' )
      case ( t_unclassified )
        call output ( 'Unclassified character ' )
        call output ( ch )
      case ( t_unk_op )
        call output ( 'Undefined operator ' )
        call display_string ( string_index )
      case ( t_unk_pun )
        call output ( 'Undefined punctuation ' )
        call display_string ( string_index )
      end select
      call output ( source_column, before=' in column ', after='.', advance='yes' )
      call error_walkback ( source_line )

    end subroutine Error

  end function Do_Action

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

! $Log: Lexer_Actions_m.f90,v $
! Revision 1.1  2022/01/24 22:04:38  vsnyder
! Initial commit
!
