find -- 文型の照合 その2 照合パターンの作りこみ: アナクロなコンピューターエンジニアのつぶやき

照合パターンを作りこみは、 getpat()で行います。実際には、makpat()が照合パターンの作成を行う。

findでは、この文型照合パターンpatに特別な記号を挿入し、管理します。

getpat()は、findとmakpat()のつなぎこみをするだけである。

RATFOR版は、下記の通り。

# getpat.r4 -- convert arguments into pattern
      integer function getpat(arg,pat)
      character arg(MAXARG),pat(MAXPAT)
      integer makpat

      getpat = makpat(arg,1,EOS,pat)
      return
      end

c getpat.for -- convert arguments into pattern
      integer function getpat(arg,pat)
      integer*1 arg(81),pat(81)         ! MAXARG(81) MAXPAT(81)
      integer makpat

      getpat = makpat(arg,1,-2,pat)     ! EOS(-2)
      return
      end

makpat()では、照合パターンの先頭以外に出てきた"%"は、そのものを表すことにします。 同様に、文型の末尾以外に出現した"$"、文型の先頭に出てきた"*"を特別扱いしないで、 その文字そのものとして扱う ようにします。そうすれば、エスケープ"@"を使って文字そのものの意味にする必要がなくなり、 使い勝手が向上します。

makpat()では、patに照合パターンをaddset()を使って設定していきます。 これを使うことでpatからあふれ出すことなく 安全に照合パターンを作りことができます。

文字の類が出現した場合、getccl()使って文字の類の符号化をします。 また、stclos()を使って閉包の処理に必要な情報をセットします。 これを使うことにより閉包の情報構造を隠ぺいすることができます。

RATFOR版は下記の通り。

# makpat.r4 -- make pattern from arg(from), teminate delim
      integer function makpat(arg,from,delim,pat)
      character arg(MAXARG),delim,pat(MAXPAT)
      integer from
      character esc
      integer stclos,addset,getccl
      integer i,j,junk,lastcl,lastj,lj
      
      j = 1
      lastj = 1
      lastcl = 0
      
      for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) {
          lj = j
          if (arg(i) == ANY)
              junk = addset(ANY,pat,j,MAXPAT)
          else if (arg(i) == BOL & i == from)
              junk = addset(BOL,pat,j,MAXPAT)
          else if (arg(i) == EOL & arg(i+1) == delim)
              junk = addset(EOL,pat,j,MAXPAT)
          else if (arg(i) == CCL) {
              if (getccl(arg,i,pat,j) == ERR) then
                  exit
              end if
              junk = addset(COLEND,pat,j,MAXPAT)
              }
          else if (arg(i) == CLOSURE & i > from) {
              lj = lastj
              if (pat(lj) == BOL | pat(lj) == EOL | pat(lj) == CLOSURE)
                  break
              lastcl = stclos(pat,j,lastj,lastcl)
              }
          else {
              junk = addset(CHAR,pat,j,MAXPAT)
              junk = addset(esc(arg,i),pat,j,MAXPAT)
              }
          lastj = lj
          }
      if (arg(i) .ne. delim) then       # terminated erarly
          makpat = ERR
      else if (addset(EOS,pat,j,MAXPAT) == NO) # no room
          makpat = ERR
      else
          makpat = i
      end if
      return
      end

WATCOM Fortran77版は下記の通り。

c makpat.for -- make pattern from arg(from), teminate delim
      integer function makpat(arg,from,delim,pat)
      integer*1 arg(81),pat(81),delim   ! MAXARG(81) MAXPAT(81)
      integer from
      integer*1 esc
      integer stclos,addset,getccl
      integer i,j,junk,lastcl,lastj,lj
      
      j = 1
      lastj = 1
      lastcl = 0
      i = from
      while ((arg(i) .ne. delim)  .and. (arg(i) .ne. -2)) do ! EOS(-2)
          lj = j
          if (arg(i) .eq. 63) then ! ANY(63 '?')
              junk = addset(63,pat,j,81) ! ANY(63 '?') MAXPAT(81)
          else if ((arg(i) .eq. 37)     ! BOL(37 '%')
     1        .and. (i .eq. from)) then
              junk = addset(37,pat,j,81) ! BOL(37 '%') MAXPAT(81)
          else if ((arg(i) .eq. 36) .and. (arg(i+1) .eq. delim)) then ! EOL(36 '$')
              junk = addset(36,pat,j,81) ! EOL(36 '%') MAXPAT(81)
          else if (arg(i) .eq. 91) then ! CCL(91 '[')
              if (getccl(arg,i,pat,j) .eq. 0) then ! NO(0)
                  exit
              end if
              ! junk = addset(93,pat,j,81) ! COLEND(93 ']') MAXPAT(81)
          else if ((arg(i) .eq. 42) .and. (i .gt. from)) then ! CLOSURE(42 '*')
              lj = lastj
              if ((pat(lj) .eq. 37)     ! BOL(37 '%')
     1            .or. (pat(lj) .eq. 36) ! EOL(36 '$')
     2            .or. (pat(lj) .eq. 42)) then ! CLOSURE(42 '*')
                  exit
              end if
              lastcl = stclos(pat,j,lastj,lastcl)
          else
              junk = addset(97,pat,j,81) ! CHAR(97 'a') MAXPAT(81)
              junk = addset(esc(arg,i),pat,j,81) ! MAXPAT(81)
          end if
          lastj = lj
          i = i + 1
      end while
      if (arg(i) .ne. delim) then       ! terminated erarly
          makpat = -1                   ! ERR(-1)
      else if (addset(-2,pat,j,81) .eq. 0) then ! no room EOS(-2) MAXPAT(81) NO(0)
          makpat = -1                   ! ERR(-1)
      else
          makpat = i
      end if
      return
      end

getccl()のRATFOR版は下記の通り。

# getccl.r4 -- expand char class at atg(i) into pat(j)
      integer function getccl(arg,i,pat,j)
      character arg(MAXARG),pat(MAXPAT)
      integer i,j
      integer addset,junk,jstart
      
      i = i + 1
      if (arg(i) == NOT) {
          junk = addset(NCCL,pat,j,MAXPAT)
          i = i + 1
          }
      else
          junk = addset(CCL,pat,j,MAXPAT)
      jstart = j
      junk = addset(0,pat,j,MAXPAT) # leave room for count
      call filset(CCLEND,arg,i,pat,j,MAXPAT)
      pat(jstart) = j - jstart - 1
      if (arg(i) == CCLEND)
          getccl = OK
      else
          getccl = ERR
      return
      end

WATCOM Fortran77版は下記の通り。

c getccl.for -- expand char class at atg(i) into pat(j)
      integer function getccl(arg,i,pat,j)
      integer*1 arg(81),pat(81)         ! MAXARG(81) MAXPAT(81)
      integer i,j
      integer addset,junk,jstart
      
      i = i + 1
      if (arg(i) .eq. 33) then          ! NOT(33 '!')
          junk = addset(110,pat,j,81)   ! NCCL(110, 'n') MAXPAT(81)
          i = i + 1
      else
          junk = addset(91,pat,j,81)    ! CCL(91, '[') MAXPAT(81)
      end if
      
      jstart = j
      junk = addset(0,pat,j,81)         ! leave room for count MAXPAT(81)
      call filset(93,arg,i,pat,j,81)    ! COLEND(93 ']')  MAXPAT(81)
      pat(jstart) = j - jstart - 1      ! save count

      if (arg(i) .eq. 93) then          ! COLEND(93 ']')
          getccl = 1                    ! OK(1)
      else
          getccl = -1                   ! ERR(-1)
      end if
      return
      end

stclos()のRATFOR版は下記の通り。

# stclos.r4 -- insert closure entry at pat(j)
      integer function stclos(pat,j,lastj,lastcl)
      character pat(MAXPAT)
      integer j,junk,jp,jt,lastj,lastcl
      integer addset,
      
      for (jp = j - 1; jp >= lastj; jp = jp - 1) {  make a hole
          jt = jp + COLSIZE
          junk = addset(pat(jp),pat,jt,MAXPAT)
          }
      j = j + CLOSIZE
      stclos = lastj
      junk = addset(CLOSURE,pat,lastj,MAXPAT)  # put closure in it
      junk = addset(0,pat,lastj,MAXPAT)        # COUNT
      junk = addset(lastcl,pat,lastj,MAXPAT)   # PREVCL
      junk = addset(0,pat,lastj,MAXPAT)        # START
      return
      end

WATCOM Fortran77版は下記の通り。

c stclos.for -- insert closure entry at pat(j)
      integer function stclos(pat,j,lastj,lastcl)
      integer*1 pat(81)                 ! MAXPAT(81)
      integer j,lastj,lastcl
      integer addset,junk,jp,jt
      
      jp = j - 1                        ! make a hole
      while (jp .ge. lastj) do
          jt = jp + 4                   ! COLSIZE(4)
          junk = addset(pat(jp),pat,jt,81) ! MAXPAT(81)
          jp = jp - 1
      end while
      j = j + 4                         ! CLOSIZE(4)
      stclos = lastj
      junk = addset(42,pat,lastj,81)    ! CLOSURE(42 '*') MAXPAT(81)
      junk = addset(0,pat,lastj,81)     ! COUNT MAXPAT(81)
      junk = addset(lastcl,pat,lastj,81) ! PREVCL MAXPAT(81)
      junk = addset(0,pat,lastj,81)    ! START MAXPAT(81)
      return
      end