translitの下請けルーチン ― 2014年12月13日 22:14
transllitの下請けルーチンは、複数ありますし、 また、それらのルーチンの下請けルーチンがあります。
まずは、makeset()。変換文字列fromとtoを作成するのに使います。
# makset.r4 -- make set from array(k) in set
integer function makset(array, k, set, size)
integer k, size
character array(ARB), set(size)
integer addset
integer i, j
i = k
j = 1
call filset(EOS, array, i,set, j, size)
makset = addset(EOS, set, j, size)
return
end
Watcom Fortran77版は、下記の通り。
c makset.for -- make set from array(k) in set
integer function makset(array, k, set, size)
integer k, size
integer*1 array(*), set(size) ! ARB(*)
integer addset
integer i, j
i = k
j = 1
call filset(-2, array, i, set, j, size) ! EOS(-2)
makset = addset(-2, set, j, size) ! EOS(-2)
return
end
addset()は、文字列setのjの位置に文字を追加できれば追加します。 やっていることは、単純ですが、モジュールとしてまとめることで、 プログラムの見通しを良くするのに一役買っています。
# addset.r4 -- put c inset(j) if it fits, increment j
integer function addset(c, set, j, maxsiz)
character c, set(maxsiz)
integer j, maxsiz
if (j > maxsiz)
addset = NO ! NO(0)
else
set(j) = c
j = j + 1
addset = YES ! YES(1)
return
end
Watcom Fortran77版は、下記の通り。
c addset.for -- put c inset(j) if it fits, increment j
integer function addset(c, set, j, maxsiz)
integer*1 c, set(maxsiz)
integer j, maxsiz
if (j .gt. maxsiz) then
addset = 0 ! NO(0)
else
set(j) = c
j = j + 1
addset = 1 ! YES(1)
endif
return
end
filset()は、略記法を考慮して、変換文字列を作り出します。
# filset.r4 -- expand set at array(i) into set(j), stop at delm
subroutine filset(delim, array, i, set, j, maxset)
character delim, array(ARB), set(maxset), esc
integer i, j, maxset
integer addset, iindex
integer junk
string lowalf "abcdefghijklmnopqrstuvwxyz"
string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
string digits "0123456789"
for ( ; array(i) != delim & array(i) != EOS; i = i + 1)
if (array(i) .eq. ESCAPE)
junk = addset(esc(array, i), set, j, maxset)
else if (array(i) != DASH)
junk = addset(array(i), set, j, maxset)
else if (j <= 1 | array(i+1) == EOS)
junk = addset(DASH, set, j, maxset) # set literal '-'
else if (iindex(digits, set(j-1)) > 0)
call dodash(digits, array, i, set, j, maxset)
else if (iindex(lowalf, set(j-1)) > 0)
call dodash(lowalf, array, i, set, j, maxset)
else if (iindex(upalf, set(j-1)) > 0)
call dodash(upalf, array, i, set, j, maxset)
else
junk = addset(DASH, set, j, maxset)
return
end
Watcom Fortran77版は、下記の通り。
c filset.for -- expand set at array(i) into set(j), stop at delm
subroutine filset(delim,array,i,set,j,maxset)
integer*1 delim, array(*), set(maxset), esc ! ARB(*)
integer i, j, maxset
integer addset, iindex
integer junk
integer*1 lowalf(27), upalf(27), digits(11)
data lowalf/'a','b','c','d','e','f','g','h','i','j','k','l','m',
1 'n','o','p','q','r','s','t','u','v','w','x','y','z',-2/ ! EOS(-2)
data upalf/'A','B','C','D','E','F','G','H','I','J','K','L','M',
1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',-2/ ! EOS(-2)
data digits/'0','1','2','3','4','5','6','7','8','9',-2/ ! EOS(-2)
while ((array(i) .ne. delim) .and. (array(i) .ne. -2)) do ! EOS(-2)
if (array(i) .eq. 64) then ! ESCAPE(64)
junk = addset(esc(array,i),set,j,maxset)
else if (array(i) .ne. 45) then ! DASH(45)
junk = addset(array(i),set,j,maxset)
else if ((j .le. 1) .or. (array(i+1) .eq. -2)) then ! EOS(-2)
junk = addset(45, set, j, maxset) ! DASH(45) ! set literal '-'
else if (iindex(digits, set(j-1)) .gt. 0) then
call dodash(digits, array, i, set, j, maxset)
else if (iindex(lowalf, set(j-1)) .gt. 0) then
call dodash(lowalf, array, i, set, j, maxset)
else if (iindex(upalf, set(j-1)) .gt. 0) then
call dodash(upalf, array, i, set, j, maxset)
else
junk = addset(45, set, j, maxset) ! DASH(45)
endif
i = i + 1
end while
return
end
filset()の下請けルーチン、addset()、iindex()はすでに紹介してあります。
esc()は、脱出記号を処理します。具体的には、次の通り。
# esc.r4 -- map array(i) into escaped character if appropriate
character function esc(array,i)
character array(ARB)
integer i
if (array(i) != ESCAPE)
esc = array(i)
else if (array(i+1) == EOS) # @ not special at end
esc = ESCAPE
else {
i = i + 1
if (array(i) == LETN)
esc = NEWLINE
else if (array(i) == LETT)
esc = TAB
else
esc = array(i)
}
return
end
Watcom Fortran77版は、下記の通り。
c esc.for -- map array(i) into escaped character if appropriate
integer*1 function esc(array,i)
integer*1 array(*) ! ARB(*)
integer i
if (array(i) .ne. 64) then ! ESCAPE(64 @)
esc = array(i)
else if (array(i+1) .eq. -2) then ! EOS(-2)
esc = 64 ! ESCAPE(@)
else
i = i + 1
if (array(i) .eq. 110) then ! LETN(110)
esc = 10 ! NEWLINE(10)
else if (array(i) .eq. 116) then ! LETT(116)
esc = 9 ! TAB(9)
else
esc = array(i)
end if
end if
return
end
dodash()は、略記を処理します。ここでもaddset()、esc()をうまく使っています。内容は次の通り。
# dodash.r4 -- expand array(i-1)-array(i+1) into set(j)... from valid
subroutine dodash(valid, array, i, set, j, maxset)
character valid(ARB), array(ARB), set(maxset)
integer i, j, maxset
integer addset, junk, iindex, limit, k
character esc
i = i + 1
j = j - 1
limit =iindex(valid,esc(array,i))
for (k = iindex(valid, set(j)); k <= limit; k = k + 1)
junk = addset(valid(k), set, j, maxset)
return
end
Watcom Fortran77版は、下記の通り。
c dodash.for -- expand array(i-1)-array(i+1) into set(j)... from valid
subroutine dodash(valid, array, i, set, j, maxset)
integer*1 valid(*), array(*), set(maxset) ! ARB(*)
integer i, j, maxset
integer addset, junk, iindex, limit, k
integer*1 esc
i = i + 1
j = j - 1
limit =iindex(valid,esc(array,i))
k = iindex(valid,set(j))
while (k .le. limit) do
junk = addset(valid(k),set,j,maxset)
k = K + 1
end while
return
end
次回は、まだ説明していない、下請けルーチンを紹介し、translitを完成させます。
最近のコメント