dc_regex.f90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
!-----------------------------------------------------------------------
!>
!> @author    Youhei SASAKI
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. see [COPYRIGHT](@ref COPYRIGHT) in detail
!> @en
!> @brief Provides simple regular expression subroutine: 'match'
!> @details
!> This module provides a simple regular expression matching function.
!>
!> @section regex_features Supported Features
!>
!> | Pattern   | Description                        |
!> |-----------|------------------------------------|
!> | `.`       | Any single character               |
!> | `?`       | Zero or one of previous            |
!> | `+`       | One or more of previous            |
!> | `*`       | Zero or more of previous           |
!> | `^`       | Beginning of string                |
!> | `$`       | End of string                      |
!> | `[abc]`   | Character class                    |
!> | `[^abc]`  | Negated character class            |
!> | `#d`      | Digit (0-9)                        |
!> | `#a`      | Alphabetic character               |
!> | `#w`      | Word character (alphanumeric + _)  |
!> | `#s`      | Whitespace                         |
!> | `#z`      | Hexadecimal digit                  |
!> | `#xHH`    | Hexadecimal character code         |
!>
!> @note The escape character is '#' instead of '\'.
!> @enden
!>
!> @ja
!> @brief シンプルな正規表現関数 'match' を提供します.
!> @details
!> このモジュールはシンプルな正規表現マッチング関数を提供します.
!>
!> @section regex_features_ja サポートする機能
!>
!> | パターン  | 説明                               |
!> |-----------|------------------------------------|
!> | `.`       | 任意の1文字                        |
!> | `?`       | 直前の0回または1回                 |
!> | `+`       | 直前の1回以上                      |
!> | `*`       | 直前の0回以上                      |
!> | `^`       | 文字列の先頭                       |
!> | `$`       | 文字列の末尾                       |
!> | `[abc]`   | 文字クラス                         |
!> | `[^abc]`  | 否定文字クラス                     |
!> | `#d`      | 数字 (0-9)                         |
!> | `#a`      | アルファベット                     |
!> | `#w`      | 単語文字 (英数字 + _)              |
!> | `#s`      | 空白文字                           |
!> | `#z`      | 16進数字                           |
!> | `#xHH`    | 16進文字コード                     |
!>
!> @note エスケープ文字は '\' ではなく '#' です.
!> @endja
!>
module dc_regex
  implicit none
  private
  public:: match
 
  character, save    :: C_ESCAPE = '#'
  integer, parameter :: SYM_EOL = -128
  integer, parameter :: SYM_ANYCHAR = 500
  integer, parameter :: SYM_QUESTION = 501
  integer, parameter :: SYM_PLUS = 502
  integer, parameter :: SYM_STAR = 503
  integer, parameter :: SYM_NORMAL_SET = 520
  integer, parameter :: SYM_REVERSED_SET = 521
  integer, parameter :: SYM_HEADFIX = 540
  integer, parameter :: SYM_TAILFIX = 541
  integer, parameter :: SYM_ISDIGIT = 560
  integer, parameter :: SYM_ISALPHA = 561
  integer, parameter :: SYM_ISWORD = 562
  integer, parameter :: SYM_ISSPACE = 563
  integer, parameter :: SYM_ISXDIGIT = 564
  integer, parameter :: SYM_COUNT_BASE = 1000
 
contains
 
  !> @en
  !> @brief Preprocess pattern string (internal use)
  !> @details
  !> Separates metacharacters and normal characters in the pattern string
  !> and converts them to an integer array for internal processing.
  !>
  !> @param[in] pattern Regular expression pattern string
  !> @param[out] symbols Integer array representing the preprocessed pattern
  !> @enden
  !>
  !> @ja
  !> @brief パターン文字列の前処理 (内部使用)
  !> @details
  !> パターン文字列内のメタキャラクタと普通の文字を分離し,
  !> 内部処理用の整数配列に変換します.
  !>
  !> @param[in] pattern 正規表現パターン文字列
  !> @param[out] symbols 前処理されたパターンを表す整数配列
  !> @endja
  subroutine preprocess_pattern(pattern, symbols)
    character(len = *), intent(in):: pattern
    integer, intent(out):: symbols(:)
    integer:: i, j, code, imax, j_last_set
    integer:: status, stat_return
    integer, parameter::     &
      & STAT_INIT = 1,       &
      & STAT_ESCAPE = 2,     &
      & STAT_OPEN_SET = 3,   &
      & STAT_IN_SET = 4,     &
      & STAT_HEXADECIMAL = 5
    character:: c
    continue
    status = stat_init
    stat_return = stat_init
    symbols(:) = sym_eol
    j_last_set = 0
    imax = len_trim(pattern)
 
    j = 1
    do, i = 1, imax
      c = pattern(i:i)
      select case(status)
      case(stat_init)
        if (c == c_escape) then
          status = stat_escape
          cycle
        else if (c == "[") then
        symbols(j) = sym_normal_set
        status = stat_open_set
        else if (c == ".") then
        symbols(j) = sym_anychar
        else if (c == "?") then
        symbols(j) = sym_question
        else if (c == "+") then
        symbols(j) = sym_plus
        else if (c == "*") then
        symbols(j) = sym_star
        else if (c == "^" .and. i == 1) then
        symbols(j) = sym_headfix
        else if (c == "$" .and. i == imax) then
        symbols(j) = sym_tailfix
        else
          symbols(j) = ichar(c)
        end if
      case(stat_escape)
        if (c == 'd' .or. c == 'D') then
          symbols(j) = sym_isdigit
        else if (c == 'a' .or. c == 'A') then
        symbols(j) = sym_isalpha
        else if (c == 'w' .or. c == 'W') then
        symbols(j) = sym_isword
        else if (c == 's' .or. c == 'S') then
        symbols(j) = sym_isspace
        else if (c == 'z' .or. c == 'Z') then
        symbols(j) = sym_isxdigit
        else if (c == 'x' .or. c == 'X') then
        symbols(j) = -1
        status = stat_hexadecimal
        cycle
        else
          symbols(j) = ichar(c)
        end if
        status = stat_return
      case(stat_hexadecimal)
        code = index("123456789ABCDEFabcdef", c)
        if (code >= 16) code = code - 6
        if (symbols(j) == -1) then
          symbols(j) = code
          cycle
        else
          symbols(j) = symbols(j) * 16 + code
          status = stat_return
        end if
      case(stat_open_set)
        symbols(j) = sym_count_base
        j_last_set = j
        stat_return = stat_in_set
        if (c == '^') then
          symbols(j - 1) = sym_reversed_set
          status = stat_in_set
        else if (c == c_escape) then
        status = stat_escape
        else
          j = j + 1
          symbols(j) = ichar(c)
          status = stat_in_set
        end if
      case(stat_in_set)
        if (c == ']') then
          symbols(j_last_set) = sym_count_base + j - j_last_set - 1
          stat_return = stat_init
          status = stat_init
          cycle
        else if (c == c_escape) then
        status = stat_escape
        cycle
        else
          symbols(j) = ichar(c)
        end if
      end select
      j = j + 1
    end do
    select case(status)
    case(stat_escape)
      symbols(j) = ichar(' ')
    case(stat_open_set)
      symbols(j) = sym_count_base
    case(stat_in_set)
      symbols(j_last_set) = sym_count_base + j - j_last_set - 1
    end select
  end subroutine preprocess_pattern
 
  !> @en
  !> @brief Match pattern at current position (internal use)
  !> @details
  !> Attempts to match the preprocessed pattern at the current position
  !> in the text. This is a recursive subroutine that implements the
  !> leftmost-longest matching algorithm.
  !>
  !> If match succeeds, length returns a non-negative value.
  !> If match fails, length returns -1.
  !>
  !> @param[in] ipat Preprocessed pattern array
  !> @param[in] text Text string to match against
  !> @param[out] length Length of match (-1 if no match)
  !> @enden
  !>
  !> @ja
  !> @brief 現在位置でのパターンマッチ (内部使用)
  !> @details
  !> 前処理されたパターンをテキストの現在位置でマッチングを試みます.
  !> これは最左最長マッチングアルゴリズムを実装する再帰サブルーチンです.
  !>
  !> マッチすれば length は非負になります.
  !> マッチしなければ length == -1 となります.
  !>
  !> @param[in] ipat 前処理されたパターン配列
  !> @param[in] text マッチ対象のテキスト文字列
  !> @param[out] length マッチした長さ (マッチしない場合は -1)
  !> @endja
  recursive subroutine match_here(ipat, text, length)
    integer, intent(in):: ipat(:)
    character(len = *), intent(in):: text
    integer, intent(out):: length
    integer:: s1, s2, remain, i, hitmax, hitcount, hit_at_least
    logical:: normal_hit
    continue
    ! パターンの終わり。空パターンには何でもマッチ
    if (size(ipat) == 0 .or. ipat(1) == sym_eol) then
      length = 0
      return
    end if
    ! パターンの文末固定指示
    if (ipat(1) == sym_tailfix) then
      if (text == "") then
        length = 0
      else
        length = -1
      end if
      return
    end if
    if (len(text) == 0) then
      length = -1
      return
    end if
    ! 1字指定(範囲または1字リテラル)の抽出 ... ipat(s1:s2)
    if (ipat(1) == sym_normal_set) then
      s1 = 3
      s2 = 2 + ipat(2) - sym_count_base
      normal_hit = .true.
    else if (ipat(1) == sym_reversed_set) then
    s1 = 3
    s2 = 2 + ipat(2) - sym_count_base
    normal_hit = .false.
    else
      s1 = 1
      s2 = 1
      normal_hit = .true.
    end if
    ! その次の記号 ipat(s2+1) は量化子か次の1字指定である
    remain = s2 + 2
    select case (ipat(s2 + 1))
    case(sym_star)
      hitmax = len(text)
      hit_at_least = 0
    case(sym_plus)
      hitmax = len(text)
      hit_at_least = 1
    case(sym_question)
      hitmax = 1
      hit_at_least = 0
    case default
      hitmax = 1
      hit_at_least = 1
      remain = s2 + 1
    end select
    ! 現位置以降の1字指定のヒット数を数える
    hitcount = 0
    do, i = 1, hitmax
      if (hit(ipat(s1:s2), text(i:i)) .neqv. normal_hit) then
        exit
      end if
      hitcount = i
    end do
    ! 現位置で無ヒットの場合、ヒットを要するならマッチ失敗
    if (hitcount < hit_at_least) then
      length = -1
      return
    end if
    ! 最長原理: なるべく長くヒットしたものから、残りのマッチする
    ! ものを探す。いわゆる最左最長探索の最長である。
    do, i = 1 + hitcount, 1 + hit_at_least, -1
      call match_here(ipat(remain: ), text(i: ), length)
      if (length >= 0) then
        length = length + i - 1
        return
      end if
    end do
    length = -1
  end subroutine match_here
 
  !> @en
  !> @brief Check if character matches pattern element (internal use)
  !> @details
  !> Checks whether the given character matches any of the pattern elements
  !> in the integer pattern array. Handles special symbols like SYM_ANYCHAR,
  !> SYM_ISALPHA, SYM_ISDIGIT, etc.
  !>
  !> @param[in] ipat Integer pattern array to match against
  !> @param[in] c Character to check
  !> @return .true. if character matches, .false. otherwise
  !> @enden
  !>
  !> @ja
  !> @brief 文字がパターン要素にマッチするか判定 (内部使用)
  !> @details
  !> 与えられた文字が整数パターン配列内のパターン要素のいずれかに
  !> マッチするかを判定します. SYM_ANYCHAR, SYM_ISALPHA, SYM_ISDIGIT
  !> などの特殊記号を処理します.
  !>
  !> @param[in] ipat マッチ判定用の整数パターン配列
  !> @param[in] c チェックする文字
  !> @return マッチすれば .true., そうでなければ .false.
  !> @endja
  logical function hit(ipat, c) result(result)
    integer, intent(in)          :: ipat(:)
    character(len=*), intent(in) :: c
    character(len=*), parameter  :: &
      & DIGIT = "0123456789",       &
      & XDIGIT = "ABCDEFabcdef",    &
      & ALPHA = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
    integer:: i
    continue
    do, i = 1, size(ipat)
      select case(ipat(i))
      case(sym_anychar)
        result = .true.
      case(sym_isalpha)
        result = (index(alpha, c) > 0)
      case(sym_isdigit)
        result = (index(digit, c) > 0)
      case(sym_isword)
        result = (index(digit, c) > 0 .or. index(alpha, c) > 0 .or. &
          & c == '_')
      case(sym_isxdigit)
        result = (index(digit, c) > 0 .or. index(xdigit, c) > 0)
      case(sym_isspace)
        result = (c == ' ' .or. (iachar(c) >= 8 .and. iachar(c) <= 13))
      case default
        result = (ipat(i) == ichar(c))
      end select
      if (result) return
    end do
    result = .false.
  end function hit
 
  !> @en
  !> @brief Match regular expression pattern against text
  !> @details
  !> Matches the given regular expression pattern against the text string.
  !>
  !> If pattern matches text, start returns the position (1-based) where
  !> the match begins, and length returns the number of matched characters.
  !>
  !> If no match is found, length == -1 and start == 0.
  !>
  !> @param[in] pattern Regular expression pattern
  !> @param[in] text Text string to search
  !> @param[out] start Starting position of match (0 if no match)
  !> @param[out] length Length of match (-1 if no match)
  !>
  !> @section match_example Example
  !>
  !> @code{.f90}
  !> program regex_test
  !>   use dc_regex, only: match
  !>   use dc_types, only: TOKEN
  !>   implicit none
  !>   integer:: start, length
  !>   character(TOKEN) :: pattern, text
  !>
  !>   pattern = "->"
  !>   text    = "time->0.0,x->hoge"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! Result: start=5, length=2
  !>
  !>   pattern = "^##+"
  !>   text    = "####### hoge"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! Result: start=1, length=7
  !>
  !>   pattern = "@+$"
  !>   text    = "# hoge @@@"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! Result: start=8, length=3
  !> end program regex_test
  !> @endcode
  !> @enden
  !>
  !> @ja
  !> @brief 正規表現パターンをテキストにマッチング
  !> @details
  !> 与えられた正規表現パターンをテキスト文字列にマッチングします.
  !>
  !> pattern が text にマッチした場合, start には文字列の何文字目から
  !> マッチしたのかを示す数値 (正の整数) が返ります.
  !> length には何文字分マッチしたのかを示す数値 (正の整数) が返ります.
  !>
  !> マッチしない場合, length == -1, start == 0 となります.
  !>
  !> @param[in] pattern 正規表現パターン
  !> @param[in] text 検索対象のテキスト文字列
  !> @param[out] start マッチの開始位置 (マッチしない場合は 0)
  !> @param[out] length マッチした長さ (マッチしない場合は -1)
  !>
  !> @section match_example_ja 例
  !>
  !> @code{.f90}
  !> program regex_test
  !>   use dc_regex, only: match
  !>   use dc_types, only: TOKEN
  !>   implicit none
  !>   integer:: start, length
  !>   character(TOKEN) :: pattern, text
  !>
  !>   pattern = "->"
  !>   text    = "time->0.0,x->hoge"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! 結果: start=5, length=2
  !>
  !>   pattern = "^##+"
  !>   text    = "####### hoge"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! 結果: start=1, length=7
  !>
  !>   pattern = "@+$"
  !>   text    = "# hoge @@@"
  !>   call match(trim(pattern), trim(text), start, length)
  !>   ! 結果: start=8, length=3
  !> end program regex_test
  !> @endcode
  !> @endja
  subroutine match(pattern, text, start, length)
    implicit none
    character(len = *), intent(in)  :: pattern, text
    integer, intent(out)            :: start, length
    integer, allocatable            :: ipattern(:)
    integer                         :: text_length
    continue
    ! 空 pattern は空文字列に適合
    if (len(pattern) <= 0) then
      length = 0
      start = 1
      return
    endif
    ! メタキャラクタの認識
    allocate(ipattern(len(pattern) + 2))
    call preprocess_pattern(pattern, ipattern)
    ! 頭寄せ指定のある場合
    if (ipattern(1) == sym_headfix) then
      start = 1
      call match_here(ipattern(2: ), text, length)
      if (length < 0) goto 995
      goto 999
    end if
    ! 最左原理
    text_length = len(text)
    do, start = 1, text_length + 1
      call match_here(ipattern, text(start:text_length), length)
      if (length >= 0) goto 999
    end do
    ! みつからない場合
995 continue
    start = 0
    length = -1
999 continue
    deallocate(ipattern)
  end subroutine match
 
end module dc_regex