// KPMTemplateb.bcpl
// Knuth-Pratt-Morris pattern matcher for IFS (bcpl portion)
// Copyright Xerox Corporation 1979

external
[
//outgoing procedures
MakeKPMTemplate

//incoming procedures
Allocate; Zero

//incoming statics
sysZone
]


//all the following declarations are known about by the code
//in KPMTemplatea.asm

structure TT:  //Template token
[
fail byte	//fail pointer
char byte	//character or special match code
]

structure T↑1,255 @TT  //Template

manifest
[
//special match codes (in place of character)
mcEnd = 0	//end of template, no trailing "*"
mcStar = 1	//"*" match character here
mcEndStar = 2	//"*" match character here, ending template
mcFail = 3	//immediate fail if you get here

mcMax = 3	//highest special match code
]

//an n-character template has n+2 tokens.
//the last two are mcEnd and mcFail.
//failures from the non-* prefix (if any) go to the mcFail token.
//failure from the mcEnd token go back to the last "*" if there
//was one, or to the mcFail token otherwise.

structure String [ length byte; char↑1,255 byte ]

//-----------------------------------------------------------------
let MakeKPMTemplate(pattern) = valof
//-----------------------------------------------------------------
//builds and returns a template for the supplied pattern string.
[
let length = pattern>>String.length
let template = Allocate(sysZone, length+2)
Zero(template, length+2)
let tBase = nil  //base of current non-"*" substring
let ti = nil  //index in current non-"*" substring
let fi = nil  //current fail pointer
let exact = true  //exact match required until we encounter "*"
for i = 1 to length+1 do
   [
   let c = (i le length? pattern>>String.char↑i, mcEnd)
   if c ge $a & c le $z then c = c-($a-$A)
   test c eq $**
      ifnot
         [
         template>>T↑i.char = c
         test exact
            ifso template>>T↑i.fail = length+2
            ifnot
               [
               ti = ti+1
               if ti gr 1 then
                  [
                  fi = fi+1
                  tBase>>T↑ti.fail = (c ne tBase>>T↑fi.char?
                   fi, tBase>>T↑fi.fail)
                  while fi ne 0 & c ne tBase>>T↑fi.char do
                     fi = tBase>>T↑fi.fail
                  ]
               ]
         ]
      ifso
         [
         template>>T↑i.char = (i eq length? mcEndStar, mcStar)
         tBase = template+i
         exact = false
         ti, fi = 0, 0
         ]
   ]
template>>T↑(length+2).char = mcFail  //append special fail token
resultis template
]

//the following procedure is hand-coded in KPMTemplatea.asm

//-----------------------------------------------------------------
//and MatchKPMTemplate(string, template) = valof
//-----------------------------------------------------------------
//matches string against template, returning zero if they match
//and the index of the first non-matching character otherwise.
//[
//let ti = 0  //template index
//for si = 1 to string>>String.length do
//   [
//   let c = string>>String.char↑si
//   if c ge $a & c le $z then c = c-($a-$A)
//   ti = ti+1
//   while ti ne 0 & c ne template>>T↑ti.char do
//      [
//      test template>>T↑ti.char le mcMax  //special match code?
//         ifnot ti = template>>T↑ti.fail
//         ifso switchon template>>T↑ti.char into
//            [
//            case mcStar:  //"*" - start new match
//               [ template = template+ti; ti = 1; endcase ]
//            case mcEndStar:  //"*" at end of template, done
//               resultis 0
//            case mcEnd:  //ran off end of template, fall back
//               [ ti = template>>T↑ti.fail; endcase ]
//            case mcFail:  //failed before first "*"
//               resultis si
//            ]
//      ]
//   ]

//if we run off the end of the string, the next template
//token must be an "end" or "end*"
//let tc = template>>T↑(ti+1).char
//resultis (tc eq mcEnd % tc eq mcEndStar?
// 0, string>>String.length+1)
//]