tree_graph__char_class Subroutine

private pure subroutine tree_graph__char_class(self)

Type Bound

tree_t

Arguments

Type IntentOptional Attributes Name
class(tree_t), intent(inout) :: self

Source Code

   pure subroutine tree_graph__char_class(self)
      use :: forgex_utf8_m, only: idxutf8, len_utf8, count_token, ichar_utf8
      use :: forgex_enums_m
      implicit none
      class(tree_t), intent(inout) :: self

      type(segment_t), allocatable :: seglist(:)
      character(:), allocatable :: buf
      type(tree_node_t) :: node

      integer :: siz, ie, i, j, i_next, i_terminal
      logical :: is_inverted

      call self%tape%get_token(class_flag=.true.)

      buf = ''
      do while (self%tape%current_token /= tk_rsbracket)
         ie = idxutf8(self%tape%token_char, 1)
         buf = buf// self%tape%token_char(1:ie)
         call self%tape%get_token(class_flag=.true.)
      end do

      is_inverted = .false.
      if (buf(1:1) == SYMBOL_CRET) then
         is_inverted = .true.
         buf = buf(2:len(buf))
      end if

      siz = len_utf8(buf)

      siz = siz - 2*count_token(buf(2:len_trim(buf)-1), SYMBOL_HYPN)

      if (buf(len_trim(buf):len_trim(buf)) == SYMBOL_HYPN) siz = siz -1

      allocate(seglist(siz))
      
      i_terminal = len(buf)
      i = 1
      j = 1
      buf = buf//char(0)

      do while (i <= i_terminal)
         ie = idxutf8(buf, i)
         i_next = ie + 1

         ! 次の文字がハイフンでないならば
         if (buf(i_next:i_next) /= SYMBOL_HYPN) then
            seglist(j)%min = ichar_utf8(buf(i:ie))
            seglist(j)%max = ichar_utf8(buf(i:ie))
            j = j + 1
         else
            seglist(j)%min = ichar_utf8(buf(i:ie))

            i = i_next + 1
            ie = idxutf8(buf, i)
            i_next = ie + 1

            seglist(j)%max = ichar_utf8(buf(i:ie))
            j = j + 1
         end if

         ! 先頭の記号がハイフンならば
         if (j == 1 .and. buf(1:1) == SYMBOL_HYPN) then
            seglist(1)%min = ichar_utf8(SYMBOL_HYPN)
            seglist(1)%max = ichar_utf8(SYMBOL_HYPN)
            i = i_next
            j = j + 1
            cycle
         end if

         ! 最後の記号がハイフンならば
         if (i >= i_terminal .and. buf(i_terminal:i_terminal) == SYMBOL_HYPN) then
            seglist(siz)%max = UTF8_CODE_MAX
            exit
         end if

         i = i_next
      end do

      ! the seglist array have been allocated near the L362.
      if (is_inverted) then
         call invert_segment_list(seglist)
      end if

      if (.not. allocated(seglist)) then
         error stop "ERROR: `seg_list` is not allocated. This should not happen."
      end if

      node = make_tree_node(op_char)
      if (.not. allocated(node%c)) allocate(node%c(size(seglist, dim=1)))

      node%c(:) = seglist(:)

      call self%register_connector(node, terminal, terminal)

   end subroutine tree_graph__char_class