var
  len : array[1..10]of byte;
  ship : array[1..100]of byte;
  count : array[1..10]of byte;
  id : array[1..100]of byte;
  lencurr : array[1..100]of byte;
  n, m : integer;

procedure readdata;
var i : integer;
begin
  readln(n, m);
  for i := 1 to n do readln(ship[i]);
  for i := 1 to m do readln(len[i]);
end;

procedure out;
var i, j : integer;
    b : boolean;
begin
  for i := 1 to m do
  begin
    writeln(count[i]);
    b := false;
    for j := 1 to n do
      if id[j] = i then
      begin
        if b then write(' ') else b := true;
        write(ship[j]);
      end;
    writeln;
  end;
  halt;
end;

procedure search(ll, l : byte);
begin
  if ll > m then out;
  if l > n then
  begin
    if lencurr[ll] = len[ll] then search(ll + 1, 1);
    exit;
  end;
  if id[l] <> 0 then begin search(ll, l + 1); exit; end;
  if lencurr[ll] + ship[l] > len[ll] then
  begin search(ll, l + 1); exit; end;
  lencurr[ll] := lencurr[ll] + ship[l];
  id[l] := ll;
  inc(count[ll]);
  search(ll, l + 1);
  dec(count[ll]);
  id[l] := 0;
  lencurr[ll] := lencurr[ll] - ship[l];
  search(ll, l + 1);
end;
{
procedure Sort(l, r: Integer);
var
  i, j, x, y : integer;
begin
  i := l; j := r; x := ship[(l + r) DIV 2];
  repeat
    while ship[i] > x do i := i + 1;
    while x > ship[j] do j := j - 1;
    if i <= j then
    begin
      y := ship[i]; ship[i] := ship[j]; ship[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
}
begin
{  assign(input, '1115.in'); reset(input);}
  readdata;
{  sort(1, n); }
  search(1, 1);
{  close(input);}
end.

I use complete search.
===========================================================
var
  len : array[1..10]of byte;
  ship : array[1..100]of byte;
  count : array[1..10]of byte;
  id : array[1..100]of byte;
  lencurr : array[1..100]of byte;
  n, m, remain : integer;

procedure readdata;
var i : integer;
begin
  readln(n, m);
  for i := 1 to n do readln(ship[i]);
  for i := 1 to m do readln(len[i]);
  remain := n;
end;

procedure out;
var i, j : integer;
    b : boolean;
begin
  for i := 1 to m do
  begin
    writeln(count[i]);
    b := false;
    for j := 1 to n do
      if id[j] = i then
      begin
        if b then write(' ') else b := true;
        write(ship[j]);
      end;
    writeln;
  end;
  halt;
end;

procedure search(ll, l : byte);
begin
  if ll > m then
  begin
    if remain = 0 then out;
    exit;
  end;
  if l > n then
  begin
    if lencurr[ll] = len[ll] then search(ll + 1, 1);
    exit;
  end;
  if id[l] <> 0 then begin search(ll, l + 1); exit; end;
  if lencurr[ll] + ship[l] > len[ll] then
  begin search(ll, l + 1); exit; end;
  lencurr[ll] := lencurr[ll] + ship[l];
  id[l] := ll;
  dec(remain);
  inc(count[ll]);
  search(ll, l + 1);
  inc(remain);
  dec(count[ll]);
  id[l] := 0;
  lencurr[ll] := lencurr[ll] - ship[l];
  search(ll, l + 1);
end;

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := ship[(l+r) DIV 2];
  repeat
    while ship[i] < x do i := i + 1;
    while x < ship[j] do j := j - 1;
    if i <= j then
    begin
      y := ship[i]; ship[i] := ship[j]; ship[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin
  readdata;
  sort(1, n);
  search(1, 1);
end.