I am having problem submiting solution.I wrote it in pascal
and I keep getting Restricted Function.Can anyone help. I
have posted the source if anyone has time to scroll through
it and see anything that my be restrited by their system.
This is my first attempt to solve 1002 i know it's kinda
lame and dynamic programming might be better than my
approach but I want at least to get it to work and get
something like Out of Time so i can rewrite it.

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);
type
  Tarr = array [1..100] of byte;
  Tarrsp = array [1..1000] of ^string;
  Tarrsppt = ^Tarrsp;
  Tarrspt = array [1..50] of Tarrsppt;
  Tarrr = array [1..100] of record i, j : byte; end;

var
  D, B : Tarr;
  W, BW : Tarrr;
  WL : Tarrspt;
  solved : boolean;
  dt, bwt : byte;
  s : string;
  p : pointer;
  i, j : word;
  f : text;
  first : boolean;

procedure indata;
var
  l : word;
  k : byte;
  s : string;
begin
  new(WL[1]);
  i := 1;
  j := 0;
  readln(f, s);
  dt := length(s);
  if s[1] = '-' then
  begin
    close(f);
    halt;
  end;
  for l := 1 to length(s) do D[l] := byte(s[l]) - byte('0');
  readln(f, l);
  for l := 1 to l do
  begin
    readln(f, s);
    inc(j);
    if j = 1001 then
    begin
      j := 1;
      inc(i);
      new(WL[i]);
    end;
    new(WL[i]^[j]);
    WL[i]^[j]^ := s;
  end;
end;

procedure outdata;
var f : text;
  i : byte;
begin
  assign(f, outfile);
  if first then
  begin
    rewrite(f);
    first := false;
  end else append(f);
  if solved then for i := 1 to bwt do write(f, WL[BW[i].i]^
[BW[i].j]^, ' ')
  else write(f, 'No solution.');
  writeln(f);
  close(f);
end;

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

procedure bt(p, lev : byte);
var k : byte;
  l : word;
begin
  if p <> 1 then
  if (B[p - 1] <> 0) then
  begin
    if (B[p - 1] <> 0) and (B[p - 1] <= lev) then exit
    else B[p - 1] := lev;
  end
  else B[p - 1] := lev;
  if p = dt + 1 then
  begin
    move(W, BW, sizeof(W));
    bwt := lev;
    solved := true;
  end;
  for k := 1 to i - 1 do
    for l := 1 to 1000 do
    if checkstring(p, WL[k]^[l]^) then
    begin
      W[lev + 1].i := k;
      W[lev + 1].j := l;
      bt(p + length(WL[k]^[l]^), lev + 1);
    end;
  for l := 1 to j do if checkstring(p, WL[i]^[l]^) then
  begin
    W[lev + 1].i := i;
    W[lev + 1].j := l;
    bt(p + length(WL[i]^[l]^), lev + 1);
  end;
end;

var l : word;
  ti : byte;
begin
  assign(f, infile);
  reset(f);
  first := true;
  repeat
    indata;
    bt(1, 0);
    outdata;
    for ti := 1 to i - 1 do
    begin
      for l := 1 to 1000 do dispose(WL[ti]^[l]);
      dispose(WL[i]);
    end;
    for l := 1 to j do dispose(WL[i]^[l]);
    dispose(WL[i]);
    solved := false;
    fillchar(B, sizeof(B), 0);
  until false;
end.

just use write(something) but not write(f,something)

> just use write(something) but not write(f,something)