As sugested I went to the CEOI homepage and downloaded all
the samples and I get all the results right.The only
problem there was that they used the word l'vov.I am sick
of 1002 I am sure there aren't any bugs in my program and I
mailed the webmaster to ask him - no reply yet. So I am
posting the damned source if anyone has any idea what might
not be compatible with delphi or if there is anything wrong
with my input output please help.Thanks to anyone who takes
his time to try to help.
Here' s the source :

-------------------------------------
const
  infile = '';
  outfile = '';
  T : array ['A'..'z'] of byte = (2, 2, 2, 3, 3, 3, 4, 4,
1, 1, 5, 5, 6, 6,
                                  0, 7, 0, 7, 7, 8, 8, 8,
9, 9, 9, 0, 0, 0, 0, 0, 0, 0,
                                  2, 2, 2, 3, 3, 3, 4, 4,
1, 1, 5, 5, 6, 6,
                                  0, 7, 0, 7, 7, 8, 8, 8,
9, 9, 9, 0);



var
  DYN, DV : array [1..100, 1..100] of byte;
  D : array [1..100] of byte;
  WL : array [1..5000] of ^string;
  WRD : array [1..100, 1..100] of word;
  dt, wlt : word;
  inf, outf : text;

function checkstring(p : byte; var s : string) : boolean;
var i : byte;
begin
  checkstring := false;
  for i := 1 to length(s) do if T[s[i]] <> D[p + i - 1]
then exit;
  checkstring := true;
end;

procedure indata;
var s : string;
  i, j : word;
  flag : boolean;
  len : byte;
begin
  readln(inf, s);
  if s[1] = '-' then
  begin
    close(inf);
    close(outf);
    halt;
  end;
  for i := 1 to length(s) do D[i] := byte(s[i]) - byte('0');
  dt := i;
  readln(inf, i);
  for i := 1 to i do
  begin
    readln(inf, s);
    flag := false;
    len := length(s);
    if (len <= dt) and (s <> 'l''vov') then for j := 1 to
dt - len + 1 do if checkstring(j, s) then
    begin
      if WRD[j, j + length(s) - 1] <> 0 then
      begin
        flag := false;
        break;
      end;
      if WRD[j, j + length(s) - 1] = 0 then
      begin
        WRD[j, j + length(s) - 1] := wlt + 1;
        DYN[j, j + length(s) - 1] := 1;
        flag := true;
      end;
    end;
    if flag then
    begin
      inc(wlt);
      new(WL[wlt]);
      WL[wlt]^ := s;
    end;
  end;
end;

procedure solve(i, j : byte);
var l, mn, dmn : byte;
begin
  if DYN[i, j] <> 0 then exit;
  mn := $ff;
  dmn := $ff;
  for l := i + 1 to j do
  begin
    solve(i, l - 1);
    if DYN[i, l - 1] = $ff then continue;
    solve(l, j);
    if (DYN[l, j] <> $ff) and
    (DYN[i, l - 1] + DYN[l, j] < mn) then
    begin
      mn := DYN[i, l - 1] + DYN[l, j];
      dmn := l;
    end;
  end;
  DYN[i, j] := mn;
  DV[i, j] := dmn;
end;

procedure writeans(i, j : byte);
begin
  if WRD[i, j] <> 0 then write(outf, WL[WRD[i, j]]^)
  else
  begin
    writeans(i, DV[i, j] - 1);
    write(outf, ' ');
    writeans(DV[i, j], j);
  end;
end;

procedure outdata;
begin
  if DYN[1, dt] <> $ff then
  begin
    writeans(1, dt);
    writeln(outf);
  end
  else writeln(outf, 'No solution.');
end;

procedure init;
begin
  fillchar(DYN, sizeof(DYN), 0);
  fillchar(DV, sizeof(DV), 0);
  fillchar(D, sizeof(D), 0);
  fillchar(WL, sizeof(WL), 0);
  fillchar(WRD, sizeof(WRD), 0);
  dt := 0;
  wlt := 0;
end;

var i : word;
begin
  assign(inf, infile);
  reset(inf);
  assign(outf, outfile);
  rewrite(outf);
  repeat
    init;
    indata;
    solve(1, dt);
    outdata;
    for i := 1 to wlt do dispose(WL[i]);
  until false;
end.