tree_graph__times Subroutine

private pure subroutine tree_graph__times(self)

This subroutine handles a quantifier range, and does not call any other recursive procedures.

Type Bound

tree_t

Arguments

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

Source Code

   pure subroutine tree_graph__times(self)
      use :: forgex_utility_m, only: get_index_comma, is_integer
      implicit none
      class(tree_t), intent(inout) :: self
      character(:), allocatable :: buf
      integer(int32) :: arg(2), ios, min, max

      type(tree_node_t) :: left, node

      integer :: i, num_comma
      character(:), allocatable :: c1, c2
      logical :: is_infinite

      ! Initialize
      ios = 0
      buf = ''
      arg(:) = INVALID_REPEAT_VAL
      c1 = ''
      c2 = ''
      is_infinite = .false.
      max = INVALID_REPEAT_VAL
      min = INVALID_REPEAT_VAL

      call self%tape%get_token()

      ! Extract the part of the pattern that is the character class that
      ! this procedure should process.
      do while (self%tape%current_token /= tk_rcurlybrace)
         buf= buf//trim(self%tape%token_char)
         call self%tape%get_token

         if (self%tape%current_token == tk_end) then
            self%code = SYNTAX_ERR_CURLYBRACE_MISSING
            self%is_valid = .false.
            return
         end if
      end do

      if (len(buf) == 0) then
      ! Error for a{}
         self%is_valid = .false.
         self%code = SYNTAX_ERR_INVALID_TIMES
         return
      else if (len(buf) == 1) then
      ! Error for a{,}
         if (buf(1:1) == SYMBOL_COMMA) then
            self%is_valid = .false.
            self%code = SYNTAX_ERR_INVALID_TIMES
            return
         end if
      end if

      if (buf(1:1) == ',') then
         buf = "0"//buf ! e.g. {,2} =>{0,2}
      end if


      if (is_integer(buf)) then
         buf = trim(buf)//","//trim(buf) ! e.g. {0} => {0,0}
      end if

   !----------------
      call get_index_comma(buf, i, num_comma)

      ! ios has a negative value if an end-of-record condition is encountered during non-advancing input,
      ! a different negative value if and endfile condition was detected on the input device, a positive value
      ! if an error was detected, or the value zero otherwise.
      !
      ! cf. Michael Metcalf, John Reid and Malcolm Cohen (2018)
      !       - "Modern Fortran Explained--Incorporating Fortran 2018"

      ! patterns like {1,2,3} are error.
      if (num_comma > 1) then
         self%is_valid = .false.
         self%code = SYNTAX_ERR_INVALID_TIMES
         return
      end if

      c1 = buf(1:i-1)
      if (i+1 <= len_trim(buf)) c2 = buf(i+1:len_trim(buf))

      read(c1, fmt=*, iostat=ios) arg(1)
      if (ios > 0 .or. arg(1)< 0) then
         self%is_valid = .false.
         self%code = SYNTAX_ERR_INVALID_TIMES
         return
      end if

      if (trim(c2) == EMPTY_CHAR) then
         is_infinite = .true.
      else
         read(c2, fmt=*, iostat=ios) arg(2)
         if (ios > 0 .or. arg(2) < 0) then
            self%is_valid = .false.
            self%code = SYNTAX_ERR_INVALID_TIMES
            return
         end if
      end if

      
      if (is_infinite) then
         min = arg(1)
         max = INFINITE
      else
         min = arg(1)
         max = arg(2)
      end if

      if (min == 0 .and. max == 0) then
         continue
      else if (max /= INFINITE .and. min > max) then
         self%is_valid = .false.
         self%code = SYNTAX_ERR_INVALID_TIMES
         return
      else if (max == INVALID_REPEAT_VAL .and. min > max) then
         self%is_valid = .false.
         self%code = SYNTAX_ERR_INVALID_TIMES
         return
      end if

      node = make_repeat_node(min, max)
      left = self%get_top()
      call self%register_connector(node, left, terminal)

   end subroutine tree_graph__times