{$apptype console}
{ $q+,r+,o-}
{$q+,r+,o+}
{ $q-,r-,o+}

uses
  math, sysutils;

type
  int = longint;
  bool = boolean;
  float = extended;
  tword = record
    w : string;
    page : int;
  end;

const
  fn = 'document';
  let : set of char = ['A'..'Z'];

var
  w : array[0..30000] of tword;
  numw : int;

  s1 : array[0..30000] of string;
  lp : array[0..30000] of int;
  curp, curn, curinn, curinp, p, l, i, n : int;

procedure newp;
begin
  curinp := 0;
  inc(curp);
end;

procedure newpage;
begin
  curinn := 1;
  inc(curn);
end;

function readword(var s : string) : string;
var
  cur : int;
begin
  cur := 1;
  while not (s[cur] in let) do begin
    inc(cur);
    if cur > length(s) then break;
  end;

  result := '';
  if cur > length(s) then begin
    s := '';
    exit;
  end;

  while s[cur] in let do begin
    result := result + s[cur];
    inc(cur);
    if cur > length(s) then begin
      break;
    end;
  end;

  delete(s, 1, cur - 1);
end;

function cmp(var w1, w2 : tword) : int;
begin
  if w1.w > w2.w then begin
    cmp := 1;
  end else if w1.w < w2.w then begin
    cmp := -1;
  end else begin
    if w1.page < w2.page then begin
      cmp := -1;
    end else if w2.page > w2.page then begin
      cmp := 1;
    end else begin
      cmp := 0;
    end;
  end;
end;

procedure qsort(l, r : int);
var
  i, j, x : int;
  y, temp : tword;
begin
  if l >= r then exit;

  x := random(r - l + 1) + l;
  y := w[x];
  w[x] := w[l];
  w[l] := y;

  i := l - 1; j := r + 1;
  while i < j do begin
    repeat inc(i) until cmp(w[i], y) >= 0;
    repeat dec(j) until cmp(y, w[j]) >= 0;

    if i < j then begin
      temp := w[i];
      w[i] := w[j];
      w[j] := temp;
    end;
  end;

  qsort(l, j);
  qsort(j + 1, r);
end;

var
  d : array[-2..30000] of int;
  numd : int;

{procedure solveword;
var
  j, i : int;
  pod : int;
begin
  d[0] := 0; d[-1] := 0; pod := 0; d[numd + 1] := 1000000;
  for i := 1 to numd + 1 do begin
    if d[i] = d[i - 1] then continue;

    if d[i] = d[i - 1] + 1 then begin
      inc(pod);
    end else begin
      pod := 0;
      if pod <= 2 then begin
        for j := d[i - 1] downto d[i - 1] - pod + 1 do begin
          write(d[j], ', ');
        end;
      end else begin
        write(d[i - 1] - pod + 1, '-', d[i - 1], ', ');
      end;
    end;
  end;
  writeln;
end;}

procedure solveword;
var
  pod, i, last : int;
  res : string;
begin
  last := -1; pod := 0; res := '';
  for i := 1 to numd do begin
    if last = d[i] then continue;
    
    if last = -1 then begin
      last := d[i];
      pod := 1;
    end else begin
      if last + 1 = d[i] then begin
        inc(pod);
        last := d[i];
      end else begin
        if pod >= 3 then begin
          res := res + inttostr(last - pod + 1) + '-' + inttostr(last) + ',';
{          write(last - pod + 1, '-', last, ', ');}
        end else begin
          if pod = 2 then begin
            res := res + inttostr(last - 1) + ',' + inttostr(last) + ',';
{            write(last - 1, ', ', last, ', ');}
          end else begin
            res := res + inttostr(last) + ',';
{            write(last, ',');}
          end;
        end;
        pod := 1;
        last := d[i];
      end;
    end;
  end;

  if pod >= 3 then begin
    res := res + inttostr(last - pod + 1) + '-' + inttostr(last) + ',';
{    write(last - pod + 1, '-', last, ', ');}
  end else begin
    if pod = 2 then begin
      res := res + inttostr(last - 1) + ',' + inttostr(last) + ',';
{      write(last - 1, ', ', last, ', ');}
    end else begin
      res := res + inttostr(last) + ',';
{      write(last, ', ');}
    end;
  end;

  if length(res) > 1 then
    writeln(copy(res, 1, length(res) - 1));

end;

begin
  reset(input, fn + '.in');
  rewrite(output, fn + '.out');

  readln(n); l := 0; p := 1; lp[p] := 0;
  while not eof(input) do begin
    inc(l);
    readln(s1[l]); s1[l] := uppercase(trim(s1[l]));
    if s1[l] = '' then begin
      inc(p);
      lp[p] := 0;
    end else begin
      inc(lp[p]);
    end;
  end;

{  for i := l + 1 to l + 10 do begin
    s1[i] := '';
  end;
  inc(l, 8);}

  curinn := 0; curinp := 0; curn := 1; curp := 1; numw := 0;
  for i := 1 to l do begin
    inc(curinn); inc(curinp);

    if s1[i] = '' then begin
      newp;
      if curinn = 1 then curinn := 0;
    end else begin
      if curinn > n then begin
        newpage;
      end else if curinn = n then begin
        if (lp[curp] - curinp = 1) then begin
          newpage;
        end else if curinp = 1 then begin
          newpage;
        end;
      end else if curinn = n - 1 then begin
        if (lp[curp] - curinp >= 2) and (lp[curp] = 3) then begin
          newpage;
        end;
      end;

      while s1[i] <> '' do begin
        inc(numw);
        w[numw].w := readword(s1[i]);
        w[numw].page := curn;
        if w[numw].w = '' then dec(numw);
      end;
    end;
  end;

  qsort(1, numw);

{  for i := 1 to numw do begin
    writeln(w[i].w);
  end;}

  w[0].w := '';
  numd := 0;
  for i := 1 to numw do begin
    if numd = 0 then begin
      write(w[i].w, ' ');
      numd := 1;
      d[numd] := w[i].page;
    end else begin
      if w[i].w = w[i - 1].w then begin
        inc(numd);
        d[numd] := w[i].page;
      end else begin
        solveword;
        write(w[i].w, ' ');
        
        numd := 1;
        d[numd] := w[i].page;
      end;
    end;
  end;
  solveword;

end.