{$A-}
Program Concordance;

Const
  MaxWordLen = 20;
  InName = 'OUT.';
  OutName = 'Con:';

Type
  CharIndex = 1..MaxWordLen;
  CountType = 1..MaxInt;
  WordType = Array [CharIndex] Of Char;
  Pointer = ^EntryType;
  EntryType =
    Record
      Left,Right : Pointer;
      Word : WordType;
      Count : CountType;
    End;

Var
  WordTree : Pointer;
  NextWord : WordType;
  Letters  : Set Of Char;
  Input,OutPut : Text;

Procedure ReadWord ( Var PackedWord : WordType );

Const
  Blank = ' ';

Var
  Buffer    : Array [CharIndex] Of Char;
  CharCount : 0..MaxWordLen;
  Ch        : Char;

Begin
  If Not Eof(Input)
    Then
      Repeat
        Read(Input,Ch)
      Until Eof(Input) Or (Ch In Letters);
  If Not Eof(Input)
    Then
      Begin
        CharCount := 0;
        While Ch In Letters Do
          Begin
            If CharCount < MaxWordLen
              Then
                Begin
                  CharCount := CharCount + 1;
                  Buffer[CharCount] := Ch
                End;
            If Eof(Input)
              Then Ch := Blank
              Else Read(Input,Ch)
          End;
        For CharCount := Charcount + 1 To MaxWordLen Do
          Buffer[CharCount] := Blank;
        PackedWord := Buffer
      End;
End; { ReadWord }

Procedure PrintWord (PackedWord : WordType);

Var
  CharPos : 1..MaxWordLen;

Begin
  For CharPos := 1 To MaxWordLen Do
    Write(OutPut,PackedWord[CharPos])
End; { PrintWord }

Procedure MakEntry ( Var Tree  : Pointer;
                         Entry : WordType);

Begin
  If Tree = Nil
    Then
      Begin
        New(Tree);
        With Tree^ Do
          Begin
            Word := Entry;
            Count := 1;
            Left := Nil;
            Right := Nil;
          End;
      End
    Else
      With Tree^ Do
        If Entry < Word
          Then MakEntry(Left,Entry)
        Else If Entry > Word
          Then MakEntry(Right,Entry)
        Else Count := Count + 1
End; { MakEntry }

Procedure PrintTree ( Tree : Pointer );

Begin
  If Tree <> Nil
    Then
      With Tree^ Do
        Begin
          PrintTree(Left);
          PrintWord(Word);
          Writeln(OutPut,Count);
          PrintTree(Right)
        End
End; { PrintTree }

Begin { Concordance }
  Assign(Input,InName);
  Assign(OutPut,OutName);
  Reset(Input);
  ReWrite(OutPut);
  Letters := ['A'..'Z','a'..'z'];
  WordTree := Nil;
  While Not Eof(Input) Do
    Begin
      ReadWord(NextWord);
      If Not Eof(Input)
        Then MakEntry(WordTree,NextWord)
    End;
  PrintTree(WordTree);
  Close(Input);
  Close(OutPut);
End.

