help

program cao;
var
  a,b,c,d,e,g,h,j,k,l,i,n,m:longint;
  s,s1,s2,s4:string;
  data:array[1..500,1..500] of ansistring;
  f:array[1..500,1..500] of boolean;
function work(a,b:string):string;
var
  next:array[1..2000] of longint;
  i,j,k,l:longint;
begin
  next[1]:=0;
  j:=0;
  for i:=2 to length(a) do
  begin
    while (j>0)and(a[i]<>a[j+1]) do j:=next[j];
    if a[i]=a[j+1] then inc(j);
    next[i]:=j;
  end;
  j:=0;
  for i:=1 to length(s) do
  begin
    while (j>0)and(s[i]<>a[j+1]) do j:=next[j];
    if s[i]=a[j+1] then inc(j);
    if j=length(a) then
    begin
      f[i-length(a)+1,i]:=true;
      data[i-length(a)+1,i]:=b;
      j:=0;
    end;
  end;
end;
function work2(a:ansistring):ansistring;
var
  i,j,k,l:longint;
  work:string;
begin
  work:='';
  for i:=1 to length(a) do
    case a[i] of
      'i','j':work:=work+chr(49);
      'a','b','c':work:=work+chr(50);
      'd','e','f':work:=work+chr(51);
      'g','h':work:=work+chr(52);
      'k','l':work:=work+chr(53);
      'm','n':work:=work+chr(54);
      'p','r','s':work:=work+chr(55);
      't','u','v':work:=work+chr(56);
      'w','y','x':work:=work+chr(57);
      'o','q','z':work:=work+chr(48);
    end;
  work2:=work;
end;
begin
  while true do
  begin
    readln(s);
    if s='' then halt;
    if s='-1' then halt;
    readln(n);
    fillchar(f,sizeof(f),0);
    for i:=1 to length(s) do
      for j:=1 to length(s) do
       data[i,j]:='';
    for i:=1 to n do
    begin
      readln(s2);
      if s2='' then halt;
      work(work2(s2),s2);
    end;
    for k:=1 to length(s) do
      for i:=1 to k do
        for j:=k to length(s) do
        if (f[i,k]and f[k+1,j]) then
        begin
          f[i,j]:=true;
          s4:=data[i,j];
          data[i,j]:=data[i,k]+' '+data[k+1,j];
          while data[i,j][1]=' ' do delete(data[i,j],1,1);
          while data[i,j][length(data[i,j])]=' '
            do delete(data[i,j],length(data[i,j]),1);
          if (s4<>'')and (length(data[i,j])>=length(s4)) then data[i,j]:=s4;
        end;
    if f[1,length(s)] then writeln(data[1,length(s)])
    else writeln('No solution.');
  end;
end.



DP;

oH
i know
i get wrong at  KMP

AC!!  ^-^

program cao;
var
a,b,c,d,e,g,h,j,k,l,i,n,m:longint;
s,s1,s2,s4:string;
data:array[1..500,1..500] of ansistring;
f:array[1..500,1..500] of boolean;
function work(a,b:string):string;
var
next:array[1..2000] of longint;
i,j,k,l:longint;
begin
next[1]:=0;
j:=0;
for i:=2 to length(a) do
begin
while (j>0)and(a[i]<>a[j+1]) do j:=next[j];
if a[i]=a[j+1] then inc(j);
next[i]:=j;
end;
j:=0;
for i:=1 to length(s) do
begin
while (j>0)and(s[i]<>a[j+1]) do j:=next[j];
if s[i]=a[j+1] then inc(j);
if j=length(a) then
begin
f[i-length(a)+1,i]:=true;
data[i-length(a)+1,i]:=b;
j:=0;
end;
end;
end;
function work2(a:ansistring):ansistring;
var
i,j,k,l:longint;
work:string;
begin
work:='';
for i:=1 to length(a) do
case a[i] of
'i','j':work:=work+chr(49);
'a','b','c':work:=work+chr(50);
'd','e','f':work:=work+chr(51);
'g','h':work:=work+chr(52);
'k','l':work:=work+chr(53);
'm','n':work:=work+chr(54);
'p','r','s':work:=work+chr(55);
't','u','v':work:=work+chr(56);
'w','y','x':work:=work+chr(57);
'o','q','z':work:=work+chr(48);
end;
work2:=work;
end;
begin
while true do
begin
readln(s);
if s='' then halt;
if s='-1' then halt;
readln(n);
fillchar(f,sizeof(f),0);
for i:=1 to length(s) do
for j:=1 to length(s) do
data[i,j]:='';
for i:=1 to n do
begin
readln(s2);
if s2='' then halt;
work(work2(s2),s2);
end;
for k:=1 to length(s) do
for i:=1 to k do
for j:=k to length(s) do
if (f[i,k]and f[k+1,j]) then
begin
f[i,j]:=true;
s4:=data[i,j];
data[i,j]:=data[i,k]+' '+data[k+1,j];
while data[i,j][1]=' ' do delete(data[i,j],1,1);
while data[i,j][length(data[i,j])]=' '
do delete(data[i,j],length(data[i,j]),1);
if (s4<>'')and (length(data[i,j])>=length(s4)) then data[i,j]:=s4;
end;
if f[1,length(s)] then writeln(data[1,length(s)])
else writeln('No solution.');
end;
end.

PLEASE SEND ME SOME TESTs!!!
 I've got WA at #8 my KMP is OK but output mb wrong...