do_debug_ast Subroutine

public subroutine do_debug_ast(flags, pattern)

Uses

Arguments

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

Source Code

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

      type(tree_t) :: tree
      integer :: root
      integer :: uni, ierr, siz
      character(:), allocatable :: buff
      character(:),allocatable :: ast, prefix, suffix, entire !, middle
      real(real64) :: lap1, lap2

      if (flags(FLAG_HELP)) call print_help_debug_ast

      call time_begin
      call tree%build(trim(pattern))
      lap1 = time_lap()

      entire = get_entire_literal(tree)
      prefix = get_prefix_literal(tree)
      ! middle = get_middle_literal(tree)
      suffix = get_suffix_literal(tree)
      lap2 = time_lap()

      open(newunit=uni, status='scratch')
      call tree%print(uni)

      inquire(unit=uni, size=siz)
      allocate(character(siz+2) :: buff)

      rewind(uni)
      read(uni, fmta, iostat=ierr) buff
      close(uni)

      ast = trim(buff)

      output: block
         character(NUM_DIGIT_KEY) :: parse_time, literal_time, tree_count, tree_allocated, &
            memory, literal_pre, literal_post, literal_all, literal_mid
         character(NUM_DIGIT_KEY) :: cbuff(9)
         integer :: i
         parse_time     = "parse time:"
         literal_time   = "extract time:"
         tree_count     = "tree node count:"
         tree_allocated = "tree node allocated:"
         literal_all    = "extracted literal:"
         literal_pre    = "extracted prefix:"
         literal_mid    = "extracted middle:"
         literal_post   = "extracted suffix:"
         memory         = "memory (estimated):"
         

         if (flags(FLAG_VERBOSE)) then
            cbuff = [parse_time, literal_time, literal_all, literal_pre, literal_mid, literal_post, &
                     memory, tree_count, tree_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_char) trim(cbuff(3)), entire
            write(stdout, fmt_out_char) trim(cbuff(4)), prefix
            ! write(stdout, fmt_out_char) trim(cbuff(5)), middle
            write(stdout, fmt_out_char) trim(cbuff(6)), suffix
            write(stdout, fmt_out_int) trim(cbuff(7)), mem_tape(tree%tape) + mem_tree(tree%nodes)
            write(stdout, fmt_out_int) trim(cbuff(8)), root
            write(stdout, fmt_out_int) trim(cbuff(9)), size(tree%nodes, dim=1)
         else if (flags(FLAG_NO_TABLE)) then
            continue
         else
            cbuff = [parse_time, literal_time, literal_all, literal_pre, literal_mid, &
                     literal_post, memory, (repeat(" ", NUM_DIGIT_KEY), i=1, 2)]
            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_char) trim(cbuff(3)), entire
            write(stdout, fmt_out_char) trim(cbuff(4)), prefix
            ! write(stdout, fmt_out_char) trim(cbuff(5)), middle
            write(stdout, fmt_out_char) trim(cbuff(6)), suffix
            write(stdout, fmt_out_int) trim(cbuff(7)), mem_tape(tree%tape)+mem_tree(tree%nodes)
         end if
      end block output

      if (flags(FLAG_TABLE_ONLY)) return
      write(stdout, fmta) ast

   end subroutine do_debug_ast