program pd;
{$L+,O-}

const infile  = 'document.in';
      outfile = 'document.out';

var n, m, r : longint;
    doc : array[1..20000]of string;
    par, pag, pc : array[1..20001]of longint;
    words : array[1..200001]of record
               word : string;
               page : longint;
              end;
    t, y : array[1..200001]of longint;

function check(id1, id2 : longint) : boolean;
 begin
  check := (words[id1].word < words[id2].word) or
           ((words[id1].word = words[id2].word) and (words[id1].page < words[id2].page));
 end;

procedure merge(l, m, r : longint);
var li, ri, ci : longint;
 begin
  ci := l;
  li := l;
  ri := m + 1;
  while ci <= r do begin
    if (li <= m) and ((ri > r) or (check(t[li], t[ri]))) then begin
      y[ci] := t[li];
      li := li + 1;
     end else begin
      y[ci] := t[ri];
      ri := ri + 1;
     end;
    ci := ci + 1; 
   end;
  for ci := l to r do t[ci] := y[ci]; 
 end;

procedure mergesort(l, r : longint);
var m : longint;
 begin
  if r - 1 <= l then begin
   if r - 1 = l then merge(l, l, r);
   end else begin
    m := (l + r) div 2;
    mergesort(l, m);
    mergesort(m + 1, r);
    merge(l, m, r);
   end;
 end;

procedure init;
 begin
  assign(input, infile); reset(input);
  assign(output, outfile); rewrite(output);
  readln(n);
  m := 0;
  while not eof do begin
    m := m + 1;
    readln(doc[m]);
   end;
  while (doc[m] = '') and (m > 0) do m := m - 1; 
 end;

procedure solve;
var i, q, cp, cl, j : longint;
 begin
  q := 1;
  for i := 1 to m do pc[i] := 0;
  for i := 1 to m do
   if doc[i] = '' then begin
     par[i] := 0;
     q := q + 1;
    end else begin
     par[i] := q;
     pc[q] := pc[q] + 1;
    end; 
  cp := 1;
  cl := 1;
  par[m + 1] := 0;
  for i := 1 to m do begin
    pag[i] := cp;
    if (cl = n) and (i > 1) and (par[i - 1] = 0) and (pc[par[i]] > 1) then begin
       cp := cp + 1;
       cl := 1;
       pag[i] := cp;
     end else
    if (cl = 1) and (((i < m) and (par[i + 1] = 0)) or (i = m)) and (pc[par[i]] > 1) then begin

      if pc[par[i]] <= 3 then begin
        cl := pc[par[i]];
        j := i - 1;
        while par[j] > 0 do begin
          pag[j] := pag[j] + 1;
          j := j - 1;
         end;
       end else begin
        cl := cl + 1;
        pag[i - 1] := pag[i - 1] + 1;
       end;

     end;
    if not ((par[i] = 0) and (cl = 1)) then begin
      cl := cl + 1;
      if cl > n then begin
        cl := 1;
        cp := cp + 1;
       end;
     end;
   end;
  r := 0;
  for i := 1 to m do begin
    doc[i] := doc[i] + ' ';
    for j := 1 to length(doc[i]) do begin
      if (UpCase(doc[i][j]) >= 'A') and (UpCase(doc[i][j]) <= 'Z') then
        words[r + 1].word := words[r + 1].word + UpCase(doc[i][j])
       else begin
        if words[r + 1].word <> '' then begin
          r := r + 1;
          words[r].page := pag[i];
         end; 
       end;
     end;
   end;
  for i := 1 to r do t[i] := i; 
  mergesort(1, r); 
 end;

var p : array[0..20000]of longint;

procedure save;
var i, j, l, c : longint;
    f : boolean;
 begin
  i := 1;
  while i <= r do begin
    write(words[t[i]].word, ' ');
    p[0] := 1;
    p[1] := words[t[i]].page;
    i := i + 1;
    while words[t[i]].word = words[t[i - 1]].word do begin
      if words[t[i]].page > p[p[0]] then begin
        p[0] := p[0] + 1;
        p[p[0]] := words[t[i]].page;
       end;
      i := i + 1;
     end;
    l := p[1];
    c := p[1];
    f := false;
    for j := 2 to p[0] do begin
      if p[j] = c + 1 then c := c + 1 else begin
        if f then write(',') else f := true;
        if c = l then write(l) else
        if c - 1 = l then write(l, ',', c) else write(l, '-', c);
        if j <= p[0] then begin l := p[j]; c := p[j]; end;
       end;
     end;
    if p[0] = 1 then write(l) else begin
        if f then write(',') else f := true;
        if c = l then write(l) else
        if c - 1 = l then write(l, ',', c) else write(l, '-', c);
     end;
    writeln; 
   end;
  close(output);
 end;

begin
 init;
 solve;
 save;
end.