home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / pretty.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-30  |  7.0 KB  |  183 lines
  1. (*  ------------------------------------------------------------------  *)
  2. (*                              PRETTY.PAS                              *)
  3. (*     Pretty erzeugt aus einem Pascal-Programm, das fehlerfrei         *)
  4. (*     uebersetzbar ist, ein neues Programm, das entsprechend der       *)
  5. (*     Pascal Block-Struktur durch Einruecken uebersichtlich            *)
  6. (*     strukturiert ist.                                                *)
  7. (*   Aufruf:                                                            *)
  8. (*     PRETTY  [[[inputfilename] outputfilename] Einruecktiefe]         *)
  9. PROGRAM Pretty;
  10. CONST
  11.   blank = '                                                             ';
  12. TYPE
  13.   tokentype = (iVAR,iTYPE,iCONST,iFUNCT,iPROC,iBEGIN,iRECORD,
  14.                iREPEAT,iCASE,iUNTIL,iEND,iEXTERN,iFORWARD,notoken);
  15.   string10  = STRING[10];
  16.   iotype    = (ein,aus);
  17. VAR
  18.   icol, level, LevelAlt, indent, NextIndent,
  19.   PUIndent, NextPUIndent, i, bow, len, first,
  20.   LineLength, AnzParam, Code, NIndent         :INTEGER;
  21.   itoken              : tokentype;
  22.   Input,Output        : TEXT;
  23.   cha                 : CHAR;
  24.   Line                : STRING[125];
  25.   letter              : SET OF CHAR;
  26.   InString,InComment  : BOOLEAN;
  27.   Filename            : ARRAY[iotype] OF STRING[30];
  28.   ifile               : iotype;
  29.   ParStr              : STRING[30];
  30.   token               : ARRAY[tokentype] OF STRING[10];
  31.   (*  ----------------------------------------------------------------  *)
  32.   (*                  sucht erstes Zeichen in der Zeile                 *)
  33.    PROCEDURE FirstNonBlank;
  34.    BEGIN
  35.      WHILE (Line[icol] = ' ') AND (icol < LineLength) DO
  36.        icol := Succ(icol);
  37.      first := icol;
  38.    END;
  39.  
  40.    (* prueft Anfang und Ende von Strings und Kommentaren und setzt      *)
  41.    (* dementsprechend die Zustandswerte InComment und InString          *)
  42.    PROCEDURE StringComment;
  43.    BEGIN
  44.      IF icol <= LineLength THEN BEGIN
  45.        IF (NOT InComment) AND (Ord(Line[icol]) = 39) THEN
  46.          InString := NOT InString;
  47.        IF NOT InString THEN
  48.          IF (Line[icol] = '(') AND (Line[icol+1] = '*') THEN
  49.            InComment := TRUE
  50.          ELSE IF Line [icol] = '{' THEN
  51.            InComment := TRUE
  52.          ELSE IF Line [icol] = '}' THEN
  53.            InComment := FALSE
  54.          ELSE IF (Line[icol] = '*') AND (Line[icol+1] = ')') THEN
  55.            InComment := FALSE;
  56.      END;
  57.    END;
  58.  
  59.    (*                sucht den Anfang des naechsten Wortes              *)
  60.    PROCEDURE BeginOfWord;
  61.    BEGIN
  62.      WHILE (NOT(Line[icol] IN letter) OR InString OR InComment)
  63.      AND (icol <= LineLength) DO BEGIN
  64.        StringComment;  icol := Succ(icol)
  65.      END;
  66.      bow := icol;
  67.    END;
  68.  
  69.    (*  sucht das Ende des aktuellen Wortes und bestimmt dessen Laenge   *)
  70.    PROCEDURE LengthOfWord;
  71.    BEGIN
  72.      len := icol;
  73.      WHILE (Line[icol] IN letter) AND (icol <= LineLength) DO
  74.        icol := Succ(icol);
  75.      len := icol - len;
  76.      StringComment;
  77.    END;
  78.  
  79.    (*   prueft, ob das gefundene Wort zu den gesuchten Token gehoert.   *)
  80.    PROCEDURE CheckToken;
  81.    VAR
  82.      found: BOOLEAN;
  83.      word : string10;
  84.  
  85.       (*          wandelt in word kleine in große Buchstaben um         *)
  86.       PROCEDURE Upper (word: string10; VAR upstr: string10);
  87.       VAR
  88.         i: INTEGER;
  89.       BEGIN
  90.         FOR i := 1 TO len DO
  91.           IF word[i] > 'Z' THEN word[i] := Chr(Ord(word[i])-32);
  92.         upstr := word;
  93.       END;
  94.  
  95.    BEGIN
  96.      itoken := iVAR;   Upper(Copy(Line,bow,len),word);
  97.      REPEAT
  98.        found := (word = token[itoken]);  itoken := Succ(itoken);
  99.      UNTIL found OR (itoken = notoken);
  100.      itoken := Pred(itoken);
  101.      IF NOT found THEN itoken := notoken;
  102.    END;
  103.  
  104. BEGIN (* Pretty *)
  105.   token[iVAR] := 'VAR';          token[iTYPE] := 'TYPE';
  106.   token[iCONST] := 'CONST';      token[iFUNCT] := 'FUNCTION';
  107.   token[iPROC] := 'PROCEDURE';   token[iBEGIN] := 'BEGIN';
  108.   token[iRECORD] := 'RECORD';    token[iREPEAT] := 'REPEAT';
  109.   token[iCASE] := 'CASE';        token[iUNTIL] := 'UNTIL';
  110.   token[iEND] := 'END';          token[iEXTERN] := 'EXTERN';
  111.   token[iFORWARD] := 'FORWARD';  token[notoken] := 'NIL';
  112.   Filename[ein] := 'PRETTY.PAS';                       (* Default-Werte *)
  113.   Filename[aus] := 'CON';         NIndent := 2;
  114.   letter := ['A'..'Z'] + ['a'..'z'];          (* Menge aller Buchstaben *)
  115.   AnzParam := ParamCount;                          (* Parameter-Analyse *)
  116.   ifile := ein;
  117.   FOR i := 1 TO AnzParam DO BEGIN
  118.     ParStr := ParamStr(i);
  119.     IF ParStr[1] IN letter THEN BEGIN
  120.       IF ifile > aus THEN BEGIN
  121.         WriteLn('FEHLER: zu viel Parameter');  Halt;
  122.       END;
  123.       Filename[ifile] := ParStr;  ifile := Succ(ifile);
  124.     END
  125.     ELSE BEGIN
  126.       Val(ParStr,NIndent,Code);
  127.       IF Code <> 0 THEN BEGIN
  128.         WriteLn('FEHLER: unerlaubter Wert ',ParStr);  Halt;
  129.       END;
  130.     END;
  131.   END;
  132.   IF Filename[ein] = Filename[aus] THEN BEGIN
  133.     WriteLn('FEHLERR: Eingabe gleich Ausgabe');  Halt;
  134.   END
  135.   ELSE
  136.     WriteLn('PRETTY ', Filename[ein],' ',Filename[aus],' ',NIndent);
  137.   Assign(Input,Filename[ein]);  ReSet(Input);
  138.   Assign(Output,Filename[aus]);  ReWrite(Output);
  139.   InString := FALSE; InComment := FALSE;                (* Anfangswerte *)
  140.   level := 0;   LevelAlt := 0;  indent := 0;   NextIndent := 0;
  141.   PUIndent := 0;  NextPUIndent := 0;
  142.   WHILE NOT Eof(Input) DO BEGIN           (* Schleife ueber alle Zeilen *)
  143.     ReadLn (Input,Line);  icol := 1;  LineLength := Length(Line);
  144.     FirstNonBlank;
  145.     WHILE icol <= LineLength DO BEGIN   (* Schleife innerhalb der Zeile *)
  146.       BeginOfWord;
  147.       IF icol <= LineLength THEN BEGIN
  148.         LengthOfWord;  CheckToken;
  149.         CASE itoken OF
  150.           iVAR..iCONST: BEGIN  NextIndent := NIndent;  indent := 0;  END;
  151.           iFUNCT,iPROC: BEGIN
  152.                           indent := 0;  NextIndent := 0;
  153.                           PUIndent := PUIndent + NIndent + 1;
  154.                           NextPUIndent := PUIndent;
  155.                         END;
  156.                 iBEGIN: BEGIN
  157.                           indent := 0;  NextIndent := 0;
  158.                           level := level + NIndent;
  159.                         END;
  160.           iRECORD..
  161.                  iCASE: level := level + NIndent;
  162.                 iUNTIL: level := level - NIndent;
  163.                   iEND: BEGIN
  164.                           level := level - NIndent;
  165.                           IF level+indent = 0 THEN
  166.                             NextPUIndent := PUIndent - NIndent - 1;
  167.                         END;
  168.           iEXTERN..
  169.               iFORWARD: NextPUIndent := PUIndent - NIndent - 1;
  170.         END; (* CASE *)
  171.       END;
  172.     END;
  173.     IF level > LevelAlt THEN          (* Ausgabe der formatierten Zeile *)
  174.       WriteLn(Output, Copy(blank,1,LevelAlt+indent+PUIndent),
  175.                       Copy(Line,first,1+LineLength-first))
  176.     ELSE
  177.       WriteLn(Output, Copy(blank,1,level+indent+PUIndent),
  178.                       Copy(Line,first,1+LineLength-first));
  179.     LevelAlt := level;  indent := NextIndent;  PUIndent := NextPUIndent;
  180.   END;
  181.   Close(Input);  Close(Output);
  182. END.
  183.