#! /usr/bin/env rexx
Trace "O"
signal on novalue name novalue
signal on halt name halt
numeric digits 12
???.char = "%"
???.mult = "*"
???.null = "00"x
???.fail = -1
if 1 = 0 then do
k = 0
do while lines("wctest.txt") > 0
data = linein("wctest.txt")
if left(data,1) = "*" then ,
iterate
if space(data) = "" then ,
iterate
k +=1
data.0 = k
data.k = data
end
end
else do
data.1 = 'patt = "12*5*78" ; word = "12578" ;'
data.2 = 'patt = "12*5*78" ; word = "123578" ;'
data.3 = 'patt = "12*5*78" ; word = "12345678" ;'
data.4 = 'patt = "12*5*78" ; word = "123478" ;'
data.5 = 'patt = "12*5*78" ; word = "125789" ;'
data.6 = 'patt = "12*5*78" ; word = "1234567" ;'
data.7 = 'patt = "%" ; word = "ABC" ;'
data.8 = 'patt = "*%" ; word = "ABC" ;'
data.9 = 'patt = "*" ; word = "ABC" ;'
data.10 = 'patt = "A*" ; word = "ABC" ;'
data.11 = 'patt = "A%" ; word = "ABC" ;'
data.12 = 'patt = "A*%" ; word = "ABC" ;'
data.13 = 'patt = "*A" ; word = "ABC" ;'
data.14 = 'patt = "*A*" ; word = "ABC" ;'
data.15 = 'patt = "A*B" ; word = "ABC" ;'
data.16 = 'patt = "AB*" ; word = "ABC" ;'
data.17 = 'patt = "*AB" ; word = "ABC" ;'
data.18 = 'patt = "*AB%" ; word = "ABC" ;'
data.19 = 'patt = "*%BC" ; word = "ABC" ;'
data.20 = 'patt = "*AB*C" ; word = "ABC" ;'
data.21 = 'patt = "*%A%B*CEND" ; word = "xAyBzCEND" ;'
data.22 = 'patt = "A*%BC*%%DEF*" ; word = "AyBCzzDEF" ;'
data.0 = 6
end
do k = 1 to data.0
interpret data.k
objs = compile(patt)
say left(">>"patt"<<", 20) ">>"objs"<<"
word = word || ???.null
wlen = length(word)
wptr = 1
do while ( objs \= "" )
parse var objs func parm objs
interpret "wptr = "func"('"word"','"wlen"','"parm"','"wptr"')"
if wptr == ???.fail then ,
leave
end
if wptr \= ???.fail then ,
say "****** word >>"word"<< matches >>"patt"<<"
end
exit
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
wcleng:procedure expose ???.
parse arg word, wlen, leng, wptr
if wlen < leng then ,
return ???.fail
return 1
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
wcmatch:procedure expose ???.
parse arg word, wlen, parm, wptr
plen = length(parm)
if wptr + plen - 1 > wlen then ,
return ???.fail
if substr(word, wptr, plen) == parm then ,
return wptr + plen
else ,
return ???.fail
return ???.fail
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
wcskip:procedure expose ???.
parse arg word, wlen, parm, wptr
plen = length(parm)
if wptr + parm - 1 > wlen then ,
return ???.fail
else ,
return wptr + parm
return ???.fail
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
wcfind:procedure expose ???.
parse arg word, wlen, parm, wptr
plen = length(parm)
wptr = pos(parm, word, wptr, wlen)
if wptr == 0 then ,
return ???.fail
else ,
return wptr + plen
return ???.fail
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
compile:procedure expose ???.
parse arg patt
patt = patt || ???.null
plen = length(patt)
leng = 0
objs = ""
find = 0
skip = 0
tokn = ""
do p = 1 to plen
ch = substr(patt, p, 1)
select
when ( ch == ???.mult ) then do
if tokn \= "" then do
objs = objs "wcmatch" tokn
tokn = ""
end
find += 1
end
when ( ch == ???.char) then do
leng += 1
if tokn \= "" then do
objs = objs "wcmatch" tokn
tokn = ""
end
skip += 1
end
otherwise do
leng += 1
if skip > 0 then do
objs = objs "wcskip" skip
skip = 0
end
if find > 0 then do
objs = objs "wcfind" ch
find = 0
iterate
end
tokn = tokn || ch
end
end
end
if tokn \= "" then ,
objs = objs "wcmatch" tokn
objs = "wcleng" leng objs
return objs
return ???.fail
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
logic_error:
say "** "copies("- ",35)
say "** Logic error at line '"sigl"' "
say "** "
exit
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
novalue:
say "** "copies("- ",35)
say "** Novalue trapped, line '"sigl"' var '"condition("D")"' "
say "** "
exit
/*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
halt
say "** "copies("- ",35)
say "** Halt trapped, line '"sigl"' var '"condition("D")"' "
say "** "
exit
|
. 
.