(**	  ID2ID - RENAME IDENTIFIERS IN A PASCAL PROGRAM.
*
*	  JAMES F. MINER    79/06/01, 79/09/30, 80/02/05, 80/02/10.
*	     SOCIAL SCIENCE RESEARCH FACILITIES CENTER.
*	  ANDY MICKEL	    79/06/28.
*	     UNIVERSITY COMPUTER CENTER
*	  UNIVERSITY OF MINNESOTA
*	  MINNEAPOLIS, MN 55455 USA
*
*	     (BASED ON AN EARLIER VERSION BY JOHN T. EASTON AND
*	      JAMES F. MINER, 76/11/29, AS MODIFIED BY ANDY MICKEL
*	      AND RICK L. MARCUS, 78/12/08)
*
*	  THE NAMES AND ORGANIZATIONS GIVEN HERE MUST NOT BE DELETED
*	  IN ANY USE OF THIS PROGRAM.
*
*	  SEE THE PTOOLS WRITEUP FOR EXTERNAL DOCUMENTATION.
*
*
**	  ID2ID - INTERNAL DOCUMENTATION.
*
*	     ID2ID READS A FILE OF IDPAIRS AND BUILDS AN AVL-BALANCED
*	  BINARY TREE OF IDENTIFIERS WHILE CHECKING FOR DUPLICATES.  IT
*	  THEN READS THE SOURCE PROGRAM AND EDITS IT TO A TARGET FILE BY
*	  SUBSTITUTING IDENTIFIERS FOUND IN THE TREE.  A FINAL CHECK IS
*	  MADE FOR NEW IDENTIFIERS WHICH WERE ALREADY SEEN IN THE
*	  SOURCE, AND A REPORT MAY BE GENERATED.
*)

PROGRAM ID2ID(SOURCE, TARGET, IDPAIRS, REPORT);

  LABEL
    13 (* FOR FATAL ERRORS *);

  CONST
    MAXLENGTH = 25;
       BLANKS = '			  ' (* MUST BE MAXLENGTH LONG *);
    ShiftBias = -32;  { ord(uppercase letter) - ord(lowercase letter) }

  TYPE
      CHARSET = SET OF CHAR;
     IDLENGTH = 1 .. MAXLENGTH;
       IDTYPE = RECORD
		    NAME: PACKED ARRAY [IDLENGTH] OF CHAR;
	       CaseShift: set of IdLength; { indices of uppercase letters }
		  LENGTH: IDLENGTH
		END;
      BALANCE = (HIGHERLEFT, EVEN, HIGHERRIGHT);
      NODEPTR = ^ NODE;
	 NODE = RECORD
			 ID: IDTYPE;
		       LEFT,
		      RIGHT: NODEPTR;
			BAL: BALANCE;
		    IDISNEW: BOOLEAN;
		CASE
		    IDISOLD: BOOLEAN OF
		  TRUE:
		    (NEWPTR: NODEPTR);
		  FALSE:
		    (SEENINSOURCE: BOOLEAN)
		END;

  VAR
       IDTABLE: NODEPTR (* SYMBOL TABLE *);

       IDPAIRS,
	SOURCE,
	TARGET,
	REPORT: TEXT;

       UpperCaseLetters,  Continuators,
       LETTERS,
	DIGITS,
	LETTERSANDDIGITS: CHARSET;


  PROCEDURE INITIALIZE;

  BEGIN
    REWRITE(REPORT);
    UpperCaseLetters :=
	       ['A','B','C','D','E','F','G','H','I','J','K','L','M',
		'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'];
    Letters := UpperCaseLetters +
	       ['a','b','c','d','e','f','g','h','i','j','k','l','m',
		'n','o','p','q','r','s','t','u','v','w','x','y','z'];
    DIGITS := ['0' .. '9'];
    LETTERSANDDIGITS := LETTERS + DIGITS;
    Continuators := LettersAndDigits + ['_']
  END (* INITIALIZE *);


  PROCEDURE READID(VAR INFILE: TEXT; VAR IDENT: IDTYPE);

    VAR
      CHCOUNT: 0 .. MAXLENGTH;

  BEGIN
    IDENT.NAME := BLANKS;   CHCOUNT := 0;  Ident.CaseShift := [];
    REPEAT
      CHCOUNT := CHCOUNT + 1;
      if InFile^ in UpperCaseLetters then
	begin
	  Ident.CaseShift := Ident.CaseShift + [ChCount];
	  Ident.Name[ChCount] := chr( ord(InFile^) - ShiftBias )
	end
      else IDENT.NAME[CHCOUNT] := INFILE^;
      get(InFile)
    UNTIL NOT (INFILE^ IN Continuators) OR (CHCOUNT = MAXLENGTH);
    IDENT.LENGTH := CHCOUNT
  END (* READID *);

  procedure WriteId(var F: Text;  var Identifier: IdType);
    var
      i:  IdLength;
  begin
    with Identifier do
      for i := 1 to Length do
	if i in CaseShift then
	  write(F, chr( ord(Name[i]) + ShiftBias ))
	else write(F, Name[i])
  end { WriteId };


  PROCEDURE READIDPAIRSANDCREATESYMBOLTABLE;

    TYPE
      IDKIND = (OLDKIND, NEWKIND);

    VAR
	OLDID,
	NEWID: IDTYPE;
	 LINK: NODEPTR (* REMEMBER NEWID POINTER *);
      LINENUM: INTEGER;
      INCRHGT: BOOLEAN;


    PROCEDURE ERROR;

    BEGIN
      WRITELN(REPORT, 'ON LINE NUMBER ': 29, LINENUM: 1,
	      ' OF THE "IDPAIRS" FILE.');
    END (* ERROR *);


    PROCEDURE ENTER(VAR IDENTIFIER: IDTYPE; KIND: IDKIND; VAR P: NODEPTR;
		    VAR INCREASEDHEIGHT: BOOLEAN);

  (* ENTER USES AN AVL-BALANCED TREE SEARCH ALGORITHM BY NIKLAUS WIRTH. *)
  (*	  (SEE SECTION 4.4 IN "ALGORITHMS + DATA STRUCTURES = PROGRAMS" *)
  (*	   PRENTICE HALL, 1976, PP. 215-222.)				*)

      VAR
	P1,
	P2: NODEPTR;

    BEGIN
      IF P = NIL THEN
	BEGIN (* ID NOT FOUND IN TREE; INSERT IT. *)
	  NEW(P);   INCREASEDHEIGHT := TRUE;
	  WITH P^ DO
	    BEGIN
	      ID := IDENTIFIER;
	      IDISNEW := KIND = NEWKIND;   IDISOLD := KIND = OLDKIND;
	      LEFT := NIL;   RIGHT := NIL;   BAL := EVEN;
	      IF IDISNEW THEN BEGIN LINK := P;	SEENINSOURCE := FALSE END
	      ELSE NEWPTR := LINK
	    END
	END
      ELSE
	IF IDENTIFIER.NAME < P^.ID.NAME THEN
	  BEGIN
	    ENTER(IDENTIFIER, KIND, P^.LEFT, INCREASEDHEIGHT);
	    IF INCREASEDHEIGHT THEN (* LEFT BRANCH HAS GROWN HIGHER *)
	      CASE P^.BAL OF
		HIGHERRIGHT:
		  BEGIN P^.BAL := EVEN;   INCREASEDHEIGHT := FALSE END;
		EVEN:
		  P^.BAL := HIGHERLEFT;
		HIGHERLEFT:
		  BEGIN (* REBALANCE *)
		    P1 := P^.LEFT;
		    IF P1^.BAL = HIGHERLEFT THEN
		      BEGIN (* SINGLE LL ROTATION *)
			P^.LEFT := P1^.RIGHT;	P1^.RIGHT := P;
			P^.BAL := EVEN;   P := P1
		      END
		    ELSE
		      BEGIN (* DOUBLE LR ROTATION *)
			P2 := P1^.RIGHT;   P1^.RIGHT := P2^.LEFT;
			P2^.LEFT := P1;   P^.LEFT := P2^.RIGHT;
			P2^.RIGHT := P;
			IF P2^.BAL = HIGHERLEFT THEN P^.BAL := HIGHERRIGHT
			ELSE P^.BAL := EVEN;
			IF P2^.BAL = HIGHERRIGHT THEN P1^.BAL := HIGHERLEFT
			ELSE P1^.BAL := EVEN;
			P := P2
		      END;
		    P^.BAL := EVEN;   INCREASEDHEIGHT := FALSE;
		  END;
	      END (* CASE *)
	  END
	ELSE
	  IF IDENTIFIER.NAME > P^.ID.NAME THEN
	    BEGIN
	      ENTER(IDENTIFIER, KIND, P^.RIGHT, INCREASEDHEIGHT);
	      IF INCREASEDHEIGHT THEN (* RIGHT BRANCH HAS GROWN HIGHER *)
		CASE P^.BAL OF
		  HIGHERLEFT:
		    BEGIN P^.BAL := EVEN;   INCREASEDHEIGHT := FALSE END;
		  EVEN:
		    P^.BAL := HIGHERRIGHT;
		  HIGHERRIGHT:
		    BEGIN (* REBALANCE *)
		      P1 := P^.RIGHT;
		      IF P1^.BAL = HIGHERRIGHT THEN
			BEGIN (* SINGLE RR ROTATION *)
			  P^.RIGHT := P1^.LEFT;   P1^.LEFT := P;
			  P^.BAL := EVEN;   P := P1
			END
		      ELSE
			BEGIN (* DOUBLE RL ROTATION *)
			  P2 := P1^.LEFT;   P1^.LEFT := P2^.RIGHT;
			  P2^.RIGHT := P1;   P^.RIGHT := P2^.LEFT;
			  P2^.LEFT := P;
			  IF P2^.BAL = HIGHERRIGHT THEN P^.BAL := HIGHERLEFT
			  ELSE P^.BAL := EVEN;
			  IF P2^.BAL = HIGHERLEFT THEN P1^.BAL := HIGHERRIGHT
			  ELSE P1^.BAL := EVEN;
			  P := P2
			END;
		      P^.BAL := EVEN;	INCREASEDHEIGHT := FALSE
		    END;
		END (* CASE *)
	    END
	  ELSE
	    BEGIN (* IDENTIFIER IS ALREADY IN TREE *)
	      INCREASEDHEIGHT := FALSE;
	      WITH P^ DO
		BEGIN
		  if Kind = OldKind then
		    begin
		      if IdIsOld then { duplicate old id's }
			BEGIN
			  WRITE(REPORT, '*** DUPLICATE OLDIDS ENCOUNTERED: ');
			  WriteId(Report, Identifier);
			  WriteLn(Report);
			  ERROR;  GOTO 13
			END
		      else IdIsOld := true;
		      NewPtr := Link
		    end
		  ELSE	{ Kind = NewKind }
		    begin
		      if IdIsNew then  { duplicate new id's }
			BEGIN
			  WRITE(REPORT, '--- WARNING:  ');
			  WriteId(Report, Identifier);
			  WriteLn(Report, ' HAS ALSO APPEARED AS ANOTHER NEWID');
			  Error
			end
		      else IdIsNew := true;
		      LINK := P
		    END
		END
	    END
    END (* ENTER *);


    PROCEDURE TRUNCATION(VAR IDENT: IDTYPE);

    BEGIN
      WRITE(REPORT, '--- WARNING:  TRUNCATION	FOR IDENTIFER, ');
      WriteId(Report, Ident);
      WriteLn(Report);
      WRITELN(REPORT, 'EXTRA CHARACTERS IGNORED.': 39);   ERROR;
      REPEAT GET(IDPAIRS) UNTIL NOT (IDPAIRS^ IN LETTERSANDDIGITS);
    END (* TRUNCATION *);


  BEGIN (* READIDPAIRSANDCREATESYMBOLTABLE *)
    IDTABLE := NIL;   RESET(IDPAIRS);	LINENUM := 1;	INCRHGT := FALSE;
    WHILE NOT EOF(IDPAIRS) DO
      BEGIN
	WHILE (IDPAIRS^ = ' ') AND NOT EOLN(IDPAIRS) DO GET(IDPAIRS);
	IF IDPAIRS^ IN LETTERS THEN
	  BEGIN
	    READID(IDPAIRS, OLDID);
	    IF IDPAIRS^ IN LETTERSANDDIGITS THEN TRUNCATION(OLDID);
	    WHILE (IDPAIRS^ IN [' ', ',']) AND NOT EOLN(IDPAIRS) DO GET(IDPAIRS);
	    IF IDPAIRS^ IN LETTERS THEN
	      BEGIN
		READID(IDPAIRS, NEWID);
		IF IDPAIRS^ IN LETTERSANDDIGITS THEN TRUNCATION(NEWID);
		ENTER(NEWID, NEWKIND, IDTABLE, INCRHGT);
		ENTER(OLDID, OLDKIND, IDTABLE, INCRHGT);
	      END
	    ELSE
	      if EOLn(IdPairs) then { map OldId to itself }
		begin
		  Enter(OldId, NewKind, IdTable, IncrHgt);
		  Enter(OldId, OldKind, IdTable, IncrHgt)
		end
	      else
		BEGIN WRITELN(REPORT, '--- WARNING:  MALFORMED IDPAIR');  ERROR END
	  END
	ELSE
	  BEGIN WRITELN(REPORT, '--- WARNING:  MALFORMED IDPAIR');   ERROR END;
	READLN(IDPAIRS);   LINENUM := LINENUM + 1
      END
  END (* READIDPAIRSANDCREATESYMBOLTABLE *);


  PROCEDURE EDITSOURCETOTARGET;

    LABEL
      1;	(* TO ESCAPE EOF INSIDE OF A COMMENT *)

    VAR
	    SOURCEID: IDTYPE;
	     DIGITSE,
      IMPORTANTCHARS: CHARSET;


    PROCEDURE SUBSTITUTE(VAR IDENTIFIER: IDTYPE; P: NODEPTR);


      PROCEDURE WRITESOURCEID;

      BEGIN
	WriteId(Target, SourceId);
	WHILE SOURCE^ IN LETTERSANDDIGITS DO
	  BEGIN WRITE(TARGET, SOURCE^);   GET(SOURCE) END
      END (* WRITESOURCEID *);


    BEGIN (* SUBSTITUTE *)
      IF P = NIL THEN (* IDENTIFIER NOT IN TREE, ECHO *) WRITESOURCEID
      ELSE
	IF IDENTIFIER.NAME < P^.ID.NAME THEN SUBSTITUTE(IDENTIFIER, P^.LEFT)
	ELSE
	  IF IDENTIFIER.NAME > P^.ID.NAME THEN SUBSTITUTE(IDENTIFIER, P^.RIGHT)
	  ELSE (* FOUND *)
	    WITH P^ DO
	      IF IDISOLD THEN
		BEGIN
		  WriteId(Target, NewPtr^.Id);
		  WHILE SOURCE^ IN LETTERSANDDIGITS DO GET(SOURCE)
		END
		  ELSE BEGIN SEENINSOURCE := TRUE;   WRITESOURCEID END
    END (* SUBSTITUTE *);


  BEGIN (* EDITSOURCETOTARGET *)
    RESET(SOURCE);   REWRITE(TARGET);
    IMPORTANTCHARS := LETTERSANDDIGITS + ['(', '{', ''''];
    DIGITSE := DIGITS + ['E','e'];
    WHILE NOT EOF(SOURCE) DO
      BEGIN
	WHILE NOT EOLN(SOURCE) DO
	  IF SOURCE^ IN IMPORTANTCHARS THEN
	    CASE SOURCE^ OF
	      'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I',
	      'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R',
	      'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
	      'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i',
	      'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r',
	      's', 't', 'u', 'v', 'w', 'x', 'y', 'z':
		BEGIN READID(SOURCE, SOURCEID);   SUBSTITUTE(SOURCEID, IDTABLE)
		END;
	      '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
		REPEAT WRITE(TARGET, SOURCE^);	 GET(SOURCE)
		UNTIL NOT (SOURCE^ IN DIGITSE);
	      '''':
		BEGIN
		  REPEAT WRITE(TARGET, SOURCE^);   GET(SOURCE)
		  UNTIL (SOURCE^ = '''') OR EOLN(SOURCE);
		  IF EOLN(SOURCE) THEN
		    WRITELN(REPORT, '--- WARNING:  UNCLOSED STRING FOUND ',
				    'IN SOURCE PROGRAM.')
		  ELSE BEGIN  WRITE(TARGET, SOURCE^);	GET(SOURCE)  END
		END;
	      '(':
		BEGIN
		  WRITE(TARGET, SOURCE^);   GET(SOURCE);
		  IF SOURCE^ = '*' THEN (* COMMENT *)
		    BEGIN  WRITE(TARGET, SOURCE^);  GET(SOURCE);
		      REPEAT
			WHILE SOURCE^ <> '*' DO
			  BEGIN
			    IF EOLN(SOURCE) THEN
			      BEGIN  WRITELN(TARGET);  READLN(SOURCE);
				IF EOF(SOURCE) THEN GOTO 1 (* EXIT SCAN *)
			      END
			    ELSE BEGIN WRITE(TARGET, SOURCE^); GET(SOURCE) END
			  END;
			WRITE(TARGET, SOURCE^);   GET(SOURCE)
		      UNTIL SOURCE^ = ')';
		      WRITE(TARGET, SOURCE^);	GET(SOURCE)
		    END
		END;
	      '{':   (* STDCOMMENT *)
		BEGIN
		  REPEAT
		    IF EOLN(SOURCE) THEN
		      BEGIN  WRITELN(TARGET);  READLN(SOURCE);
			IF EOF(SOURCE) THEN GOTO 1  (* EXIT SCAN *)
		      END
		    ELSE BEGIN WRITE(TARGET, SOURCE^); GET(SOURCE) END
		  UNTIL SOURCE^ = '}';
		  WRITE(TARGET, SOURCE^);   GET(SOURCE)
		END
	    END (* CASE *)
	  ELSE (* OTHER CHARACTERS *)
	    BEGIN  WRITE(TARGET, SOURCE^);   GET(SOURCE) END;
	READLN(SOURCE);   WRITELN(TARGET)
      END;
    1: (* COME FROM EOF INSIDE OF COMMENT *)
  END (* EDITSOURCETOTARGET *);


  PROCEDURE CHECKSEENINSOURCE(P: NODEPTR);

  BEGIN
    IF P <> NIL THEN
      BEGIN
	CHECKSEENINSOURCE(P^.LEFT);
	WITH P^ DO
	  IF IDISNEW AND NOT IDISOLD THEN
	    IF SEENINSOURCE THEN
	      BEGIN
		WRITE(REPORT, '--- WARNING:  ');
		WriteId(Report, Id);
		WriteLn(Report, ' WAS SPECIFIED AS A NEW IDENTIFIER ');
		WRITELN(REPORT, 'AND WAS ALSO SEEN IN THE SOURCE ': 46,
			'PROGRAM UNCHANGED.');
	      END;
	CHECKSEENINSOURCE(P^.RIGHT)
      END
  END (* CHECKSEENINSOURCE *);


BEGIN (* ID2ID *)
  INITIALIZE;
  READIDPAIRSANDCREATESYMBOLTABLE;
  EDITSOURCETOTARGET;
  CHECKSEENINSOURCE(IDTABLE);
13:
END (* ID2ID *).