Only don's tell me about arrays size, because mistakes is not here...
This is my program:

Program t1002;
  Const  alp:array ['a'..'z'] of char=
('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  t              :string[100];
       s              :string[50];
       c,ans          :array [1..100,1..2] of longint;
       b              :array [1..10{0},1..50] of string[50];
       ok             :boolean;
       MaxLength      :byte;
       n,i,j,q,count,k:longint;

Procedure Entry;
  Begin
    For j:=1 to (Length(t)-Length(s)+1) Do
      If (s[1]=t[j]) or (alp[s[1]]=t[j]) Then
        Begin
          ok:=true;
          For q:=1 to Length(s) Do
            If (s[q]<>t[j-1+q]) and (alp[s[q]]<>t[j-1+q]) Then
              Begin
                ok:=false;
                Break;
              End;
          If ok Then
            b[j,Length(s)]:=s;
        End;
  End;

Procedure Solve(u:byte);
  Var  w:byte;
  Begin
    If k<count Then
      Begin
        If u>Length(t) Then
          Begin
            If k<count Then
              Begin
                count:=k;
                For i:=1 to count Do
                  Begin
                    ans[i,1]:=c[i,1];
                    ans[i,2]:=c[i,2];
                  End;
              End;
          End
        Else
          Begin
            For w:=MaxLength downto 1 Do
              If b[u,w]<>'' Then
                Begin
                  Inc(k);
                  c[k,1]:=u;
                  c[k,2]:=w;
                  Solve(u+w);
                  Dec(k);
                End;
          End;
      End;
  End;

Procedure Out;
  Begin
    If count=54321 Then
      WriteLn('No solution.')
    Else
      Begin
        For i:=1 to (count-1) Do
          Write(b[ans[i,1],ans[i,2]],' ');
        WriteLn(b[ans[count,1],ans[count,2]]);
      End;
  End;

Procedure Input;
  Begin
    While true Do
      Begin
        ReadLn(t); If t='-1' Then Halt;
        ReadLn(n);
        maxLength:=0;
        For i:=1 to Length(t) Do
          For j:=1 to 50 Do
            b[i,j]:='';
        While n>0 Do
          Begin
            Dec(n);
            ReadLn(s);
            If Length(s)>MaxLength Then
              MaxLength:=Length(s);
            Entry;
          End;
        count:=54321;
        k:=0;
        Solve(1);
        Out;
      End;
  End;

Begin
  Input;
End.