文字列の変換 -- translit ― 2014年12月07日 12:12
コマンドラインの引数がとれるようになったので、引数を使ったプログラムを 紹介します。 文字列の置き換えプログラムtranslitです。
translitは、標準入力から読み込んだ文字をコマンドラインの引数の指示に従い変換します。たとえば、
translit x y
は、文字"x"を文字"y"に変換します。また、
translit xy yx
は、文字"x"を文字"y"に、文字"y"を文字"x"に変換します。さらには、
translit a-z A-Z
は、英小文字を英大文字に変換します。"a-z"は、"abcdefghijklmnopqrstuvwxyz"の略記です。
translit a-zA-Z a
とすれば、英文字列を文字"a"一文字に押しつぶします。また、
translit 0-9 n
とすれば、数字列を文字"n"一文字に押しつぶします。
translit 0-9
とすれば、数字列を削除することになります。もう少し拡張します。
translit !a-z -
とすれば、英小文字以外は、改行も含め、"-"に変換されます。
脱出文字"@"も使えます。"@n"とすれば改行を意味し、"@t"は、タブです。"@"自身は"@@"と表現できます。
translit @n N
とすれば、改行が文字"N"に変換され、
translit @t T
とすれば、タブが文字"T"に変換されます。
このように、translitは一種のフィルターです。
translitのメイン部分は下記の通り。
# translit.r4 -- map characters
character getc
character arg(MAXARR), c, from(MAXSET), to(MAXSET)
integer getarg, length, makset, xindex
integer allbut, collap, i, lastto
allbut = NO
if (getarg(1, arg, MAXARR) == NO)
call error('usage: translit from to.')
else if (arg(1) == NOT)
allbut = YES
if (makset(arg, 2, from, MAXSET) == NO)
call error('from: too large.')
else
allbut = NO
if (makset(arg, 1, from, MAXSET) == NO)
call error('from: too large.')
if (getarg(2,arg,MAXARR) == NO)
to(1) = EOS
else if (makset(arg, 1, to, MAXSET) == NO)
call error('to: too large.')
lastto = length(to)
if (length(from) > lastto | allbut == YES)
collap = YES
else
collap = NO
repeat {
i = xindex(from, getc(c), allbut, lastto)
if (collap == YES & i >= lastto & lastto > 0) { # collapse
call putc(to(lastto))
repeat
i = xindex(from, getc(c), allbut, lastto)
until (i < lastto)
}
if (c == EOF) {
call putc(EOF)
break
}
if (i > 0 & lastto > 0) # translate
call putc(to(i))
else if (i == 0) # copy
call putc(c)
# else delete
}
stop
end
プログラムの前半は、コマンドラインの引数から、変換ルールの文字列を作成することに費やされています。 後半は、標準入力からEOFを読みとるまで、変換して標準出力へ書き出します。
Watcom Fortran77版は、下記の通り。
c translit.for -- map characters
program translit
integer*1 getc
integer*1 arg(100), c, from(200), to(200) ! MAXARR(100) MAXSET(00)
integer getarg, length, makset, xindex
integer allbut, collap, i, lastto
allbut = 0 ! NO(0)
if (getarg(1, arg, 100) .eq. 0) then ! MAXARR(100) NO(0)
call error('usage: translit from to.')
else if (arg(1) .eq. 33) then ! NOT(33)
allbut = 1 ! YES(1)
if (makset(arg, 2, from, 200) .eq. 0) then ! MAXSET(200) NO(0)
call error('from: too large.')
end if
else
allbut = 0 ! NO(0)
if (makset(arg, 1, from, 200) .eq. 0) then ! MAXSET(200) NO(0)
call error('from: too large.')
end if
end if
if (getarg(2, arg, 100) .eq. 0) then ! MAXARR(100)
to(1) = -2 ! EOS
else if (makset(arg, 1, to, 200) .eq. 0) then ! MAXSET(200) NO(0)
call error('to: too large.')
end if
lastto = length(to)
if (length(from) .gt. lastto .or. allbut .eq. 1) then ! YES(1)
collap = 1 ! YES(1)
else
collap = 0 ! NO(0)
end if
loop
i = xindex(from, getc(c), allbut, lastto)
if (collap .eq. 1
1 .and. i .ge. lastto .and. lastto .gt. 0) then ! collapse
call putc(to(lastto))
loop
i = xindex(from, getc(c), allbut, lastto)
until (i .lt. lastto)
end if
if (c .eq. -1) then ! EOF(-1)
call putc(-1) ! EOF(-1)
exit
end if
if (i .gt. 0 .and. lastto .gt. 0) then ! translate
call putc(to(i))
else if (i .eq. 0) then ! copy
call putc(c)
end if ! else delete
end loop
stop
end
次回からは、translitの下請けルーチンを紹介します。
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を完成させます。
最近のコメント