do_debug_thompson Subroutine

public subroutine do_debug_thompson(flags, pattern)

Uses

Arguments

Type IntentOptional Attributes Name
logical, intent(in) :: flags(:)
character(len=*), intent(in) :: pattern

Source Code

   subroutine do_debug_thompson(flags, pattern)
      use :: forgex_cli_memory_calculation_m
      use :: forgex_automaton_m
      use :: forgex_syntax_tree_graph_m
      implicit none
      logical, intent(in) :: flags(:)
      character(*), intent(in) :: pattern

      type(tree_t) :: tree
      type(automaton_t) :: automaton
      integer :: root
      integer :: uni, ierr, i
      character(:), allocatable :: nfa
      character(256) :: line
      real(real64) :: lap1, lap2

      nfa = ''

      if (flags(FLAG_HELP)) call print_help_debug_thompson
      if (pattern == '') call print_help_debug_thompson

      call time_begin()
      ! call build_syntax_tree(trim(pattern), tree%tape, tree, root)
      call tree%build(trim(pattern))
      lap1 = time_lap()

      call automaton%nfa%build(tree, automaton%nfa_entry, automaton%nfa_exit, automaton%all_segments)
      lap2 = time_lap()

      open(newunit=uni, status='scratch')
      call automaton%nfa%print(uni, automaton%nfa_exit)

      rewind(uni)
      ierr = 0
      do while (ierr == 0)
         read(uni, fmta, iostat=ierr) line
         if (ierr /= 0) exit

         if (get_os_type() == OS_WINDOWS) then
            nfa = nfa//trim(line)//CRLF
         else
            nfa = nfa//trim(line)//LF
         end if

      end do
      close(uni)

      output: block
         character(NUM_DIGIT_KEY) :: parse_time, nfa_time, memory, nfa_count, nfa_allocated, tree_count, tree_allocated
         character(NUM_DIGIT_KEY) :: cbuff(7) = ''
         integer :: memsiz

         parse_time     = "parse time:"
         nfa_time       = "compile nfa time:"
         memory         = "memory (estimated):"

         nfa_count      = "nfa states:"
         nfa_allocated  = "nfa states allocated:"
         tree_count     = "tree node count:"
         tree_allocated = "tree node allocated:"

         memsiz = mem_tape(tree%tape) + mem_tree(tree%nodes) &
                  + mem_nfa_graph(automaton%nfa) + 4*3
         if (allocated(automaton%entry_set%vec)) then
            memsiz = memsiz + size(automaton%entry_set%vec, dim=1)
         end if
         if (allocated(automaton%all_segments)) then
            memsiz = memsiz + size(automaton%all_segments, dim=1)*8
         end if

         if (flags(FLAG_VERBOSE)) then
            cbuff = [parse_time,  nfa_time, memory, tree_count, tree_allocated, nfa_count, nfa_allocated]
            call right_justify(cbuff)

            write(stdout, fmt_out_time) trim(cbuff(1)), get_lap_time_in_appropriate_unit(lap1)
            write(stdout, fmt_out_time) trim(cbuff(2)), get_lap_time_in_appropriate_unit(lap2)
            write(stdout, fmt_out_int)  trim(cbuff(3)), memsiz
            write(stdout, fmt_out_int) trim(cbuff(4)), root
            write(stdout, fmt_out_int) trim(cbuff(5)), size(tree%nodes, dim=1)
            write(stdout, fmt_out_int) trim(cbuff(6)), automaton%nfa%nfa_top
            write(stdout, fmt_out_int) trim(cbuff(7)), automaton%nfa%nfa_limit
         else if (flags(FLAG_NO_TABLE)) then
            continue
         else
            cbuff(:) = [parse_time, nfa_time, memory, (repeat(" ", NUM_DIGIT_KEY), i = 1, 4)]
            call right_justify(cbuff)

            write(stdout, fmt_out_time) trim(cbuff(1)), get_lap_time_in_appropriate_unit(lap1)
            write(stdout, fmt_out_time) trim(cbuff(2)), get_lap_time_in_appropriate_unit(lap2)
            write(stdout, fmt_out_int) trim(cbuff(3)), memsiz
         end if

         if (flags(FLAG_TABLE_ONLY)) return

         write(stdout, *) ""
         write(stdout, fmta) HEADER_NFA
         write(stdout, fmta) trim(nfa)
         write(stdout, fmta) "Note: all segments of NFA were disjoined with overlapping portions."
         write(stdout, fmta) FOOTER

      end block output
   end subroutine do_debug_thompson