tree_graph__shorthand Subroutine

private pure subroutine tree_graph__shorthand(self)

Uses

This function handles shorthand escape sequences (\t, \n, \r, \d, \D, \w, \W, \s, \S).

Type Bound

tree_t

Arguments

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

Source Code

   pure subroutine tree_graph__shorthand(self)
      use :: forgex_utf8_m, only: ichar_utf8
      implicit none
      class(tree_t), intent(inout) :: self
      type(tree_node_t) :: node
      type(segment_t), allocatable :: seglist(:)
      type(segment_t) :: seg
      character(:), allocatable :: chara


      select case (trim(self%tape%token_char))
      case (ESCAPE_T)
         node = make_atom(SEG_TAB)
         call self%register_connector(node, terminal, terminal)
         return

      case (ESCAPE_N)
         call self%crlf()
         return

      case (ESCAPE_R)
         node = make_atom(SEG_CR)
         call self%register_connector(node, terminal, terminal)
         return

      case (ESCAPE_D)
         node = make_atom(SEG_DIGIT)
         call self%register_connector(node, terminal, terminal)
         return

      case (ESCAPE_D_CAPITAL)
         allocate(seglist(1))
         seglist(1) = SEG_DIGIT
         call invert_segment_list(seglist)

      case (ESCAPE_W)
         allocate(seglist(4))
         seglist(1) = SEG_LOWERCASE
         seglist(2) = SEG_UPPERCASE
         seglist(3) = SEG_DIGIT
         seglist(4) = SEG_UNDERSCORE

      case (ESCAPE_W_CAPITAL)
         allocate(seglist(4))
         seglist(1) = SEG_LOWERCASE
         seglist(2) = SEG_UPPERCASE
         seglist(3) = SEG_DIGIT
         seglist(4) = SEG_UNDERSCORE
         call invert_segment_list(seglist)

      case (ESCAPE_S)
         allocate(seglist(6))
         seglist(1) = SEG_SPACE
         seglist(2) = SEG_TAB
         seglist(3) = SEG_CR
         seglist(4) = SEG_LF
         seglist(5) = SEG_FF
         seglist(6) = SEG_ZENKAKU_SPACE

      case (ESCAPE_S_CAPITAL)
         allocate(seglist(6))
         seglist(1) = SEG_SPACE
         seglist(2) = SEG_TAB
         seglist(3) = SEG_CR
         seglist(4) = SEG_LF
         seglist(5) = SEG_FF
         seglist(6) = SEG_ZENKAKU_SPACE
         call invert_segment_list(seglist)

      case default
         chara = self%tape%token_char
         seg = segment_t(ichar_utf8(chara), ichar_utf8(chara))
         node = make_atom(seg)
         call self%register_connector(node, terminal, terminal)
         return
      end select

      allocate(node%c(size(seglist, dim=1)))
      ! This size function is safe because it is always allocated 
      ! to the non-returned branches of the select case above.

      node%c(:) = seglist(:)
      node%op = op_char

      call self%register_connector(node, terminal, terminal)

      deallocate(seglist)

   end subroutine tree_graph__shorthand