home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / visible.arj / PRETTY2 < prev    next >
Text File  |  1985-08-08  |  7KB  |  253 lines
  1. (*******************************************************)
  2. (*        PD/L PRETTYPRINTER VERSION 1.0               *)
  3. (*     COPYRIGHT  1984 BY WILLIAM H. HAPGOOD           *)
  4. (*       LAST REVISION NOV.   6, 1984                  *)
  5. (*******************************************************)
  6.  
  7. {To use this prettyprinter, use the command:
  8. {
  9. {               PRETTY <INFILE  >OUTFILE
  10. {
  11. { where INFILE is the program to prettyprint, and
  12. { OUTFILE is the name of the new, pretty file. They must not be the same!
  13. {
  14. {This is an example of using re-directed input and output, a handy part
  15. {of DOS 2.0; you can write programs using INPUT and OUTPUT for files,
  16. {and later, when you run the program, decide what files should be used
  17. {for the input and output.
  18.                                 }
  19. PROGRAM PRETTY;
  20.  
  21.   
  22. CONST
  23.   S = ' ';
  24.   APOSTROPHE = "'";
  25.   QUOTES = '"';
  26.   
  27.   
  28. TYPE
  29.   SYMBOL = (NOTHING,FIRST1,COMMENT,PROCSY,BEGINSY,IFSY,THENSY,DECLSY,
  30.   ELSESY,REPEATSY,UNTILSY,WHILESY,DOSY,FORSY,
  31.   CASESY,ENDSY,RECORDSY,NOBLKSYS,
  32.   SEMI,LBRACK,RBRACK,LPAREN,RPAREN,ENDOFILE);
  33.   
  34. VAR
  35.   SY : SYMBOL;
  36.   FIRSTSY : SYMBOL;
  37.   ID : STRING;
  38.   CH : CHAR;
  39.   
  40.   CLINE : STRING;
  41.   CHCNT : INTEGER;
  42.   INDENT : INTEGER;
  43.   QUANTUM : INTEGER;
  44.   
  45.   NESTLEVEL : INTEGER;
  46.   SOLNEST : INTEGER;
  47.   NOBLOCK : BOOLEAN;
  48.   MAKEUC  : BOOLEAN;
  49.  
  50.  
  51.  
  52. PROCEDURE FINDKEYWORD;  {if a keyword, set sy to correct value}
  53. BEGIN
  54.   IF ID = 'END' THEN SY := ENDSY ELSE
  55.   IF ID = 'BEGIN' THEN SY := BEGINSY ELSE
  56.   IF ID = 'IF' THEN SY := IFSY ELSE
  57.   IF ID = 'THEN' THEN SY := THENSY ELSE
  58.   IF ID = 'ELSE' THEN SY := ELSESY ELSE
  59.   IF ID = 'REPEAT' THEN SY := REPEATSY ELSE
  60.   IF ID = 'UNTIL' THEN SY := UNTILSY ELSE
  61.   IF ID = 'VAR' THEN SY := DECLSY ELSE
  62.   IF ID = 'FOR' THEN SY := FORSY ELSE
  63.   IF ID = 'WHILE' THEN SY := WHILESY ELSE
  64.   IF ID = 'CASE' THEN SY := CASESY ELSE
  65.   IF ID = 'PROCEDURE' THEN SY := PROCSY ELSE
  66.   IF ID = 'TYPE' THEN SY := DECLSY ELSE
  67.   IF ID = 'CONST' THEN SY := DECLSY ELSE
  68.   IF ID = 'FUNCTION' THEN SY := PROCSY;
  69. END;
  70.  
  71.  
  72. PROCEDURE WRITELINE;
  73. BEGIN
  74.   INDENT := SOLNEST*QUANTUM;
  75.   IF (INDENT<>0) AND (FIRSTSY IN [THENSY,ELSESY]) THEN INDENT := INDENT-1;
  76.   CLINE[0] := CHR(CHCNT-1);
  77.   WRITELN(CLINE:CHCNT-1+INDENT);
  78.   SOLNEST := NESTLEVEL; FIRSTSY := FIRST1;
  79. END;
  80.  
  81. FUNCTION UPCASE(CH:CHAR):CHAR;
  82. BEGIN
  83.   IF CH IN ['a'..'z'] THEN UPCASE := CHR(ORD(CH)-32) ELSE UPCASE := CH;
  84. END;
  85.  
  86.  
  87. PROCEDURE NEXTCH;
  88. BEGIN
  89.   IF EOLN THEN {line feed}
  90.     BEGIN
  91.       WRITELINE;
  92.       CHCNT := 1;     {1st char.}
  93.       IF NOT EOF THEN
  94.         REPEAT READ(CH); IF EOLN THEN WRITELINE UNTIL EOF OR (CH <> ' ');
  95.     END ELSE BEGIN READ(CH); CHCNT := CHCNT + 1; END;
  96.   IF MAKEUC THEN CH := UPCASE(CH);
  97.   CLINE[CHCNT] := CH;
  98. END;
  99.  
  100.  
  101. PROCEDURE INSYMBOL;
  102. VAR
  103.   K:INTEGER;
  104. BEGIN
  105.   SY := NOTHING;
  106.   WHILE (CH = ' ') AND NOT EOF DO NEXTCH;
  107.   IF (CH IN ['A'..'Z','a'..'z','0'..'9','$',':',',','.','+','-','*','/',
  108.     APOSTROPHE, QUOTES, '{','(',')','[',']',';','<','>','=']) 
  109.     AND NOT EOF THEN
  110.     CASE CH OF
  111.     'A'..'Z','a'..'z': 
  112.     BEGIN
  113.       K := 0;
  114.       REPEAT
  115.         IF K < 9 THEN BEGIN K := K+1; ID[K] := CH; END;
  116.         NEXTCH;
  117.       UNTIL NOT (CH IN ['A'..'Z', '0'..'9', '_']) OR EOF;
  118.       ID[0] := CHR(K);
  119.       FINDKEYWORD;      {see if key, return sy set correctly if so}
  120.     END;
  121.     
  122.     '0'..'9',  '$' : 
  123.     REPEAT NEXTCH UNTIL NOT (CH IN ['0'..'9', 'A'..'F']) OR EOF;
  124.     ':',',','.','<','>','=','+','-','*','/':
  125.     REPEAT NEXTCH
  126.     UNTIL NOT (CH IN [':',',','.','<','>','=','+','-','*','/']) OR EOF;
  127.     
  128.     APOSTROPHE: 
  129.       BEGIN MAKEUC := FALSE; 
  130.         REPEAT NEXTCH UNTIL (CH = APOSTROPHE) OR EOF;
  131.         MAKEUC := TRUE; NEXTCH;
  132.       END;
  133.     QUOTES: 
  134.       BEGIN MAKEUC := FALSE;
  135.         REPEAT NEXTCH UNTIL (CH = QUOTES) OR EOF;
  136.         MAKEUC := TRUE; NEXTCH;
  137.       END;
  138.     ')': BEGIN NEXTCH; SY := RPAREN; END;
  139.     '[': BEGIN NEXTCH; SY := LBRACK; END;
  140.     ']': BEGIN NEXTCH; SY := RBRACK; END;
  141.     ';': BEGIN NEXTCH; SY := SEMI; END;
  142.     '{': BEGIN MAKEUC := FALSE; REPEAT NEXTCH UNTIL (CH = '}') OR EOF;
  143.           MAKEUC := TRUE; NEXTCH; SY := COMMENT; END;
  144.     '(':
  145.     BEGIN
  146.       NEXTCH;
  147.       IF CH = '*' THEN
  148.         BEGIN
  149.           MAKEUC := FALSE; NEXTCH;
  150.           REPEAT
  151.             WHILE (CH <> '*') AND NOT EOF DO NEXTCH;
  152.             NEXTCH;
  153.           UNTIL (CH = ')') OR EOF;
  154.           MAKEUC := TRUE; NEXTCH; SY := COMMENT;
  155.         END ELSE SY := LPAREN;
  156.     END;
  157.   END ELSE NEXTCH;
  158.   IF FIRSTSY = FIRST1 THEN FIRSTSY := SY;
  159.   IF EOF THEN SY := ENDOFILE;
  160. END;
  161.  
  162. PROCEDURE INSYM;
  163. BEGIN
  164.   REPEAT INSYMBOL UNTIL SY <> COMMENT;
  165. END;
  166.  
  167.  
  168.  
  169. (*           *******END SOURCE READING SECTION  **********)
  170.  
  171.  
  172. PROCEDURE DECLARATIONS; {enter --> declbegsys; leave --> begin,proc,func}
  173. BEGIN
  174.   IF SY = DECLSY THEN
  175.     REPEAT
  176.       NESTLEVEL := NESTLEVEL + 1;
  177.       REPEAT 
  178.         INSYM;
  179.         IF SY IN [RECORDSY,LPAREN] THEN NESTLEVEL := NESTLEVEL + 1;
  180.         IF (SY IN [ENDSY,RPAREN]) AND  (NESTLEVEL > 0)
  181.          THEN NESTLEVEL := NESTLEVEL - 1;
  182.       UNTIL SY IN [BEGINSY,PROCSY,DECLSY];
  183.       IF NESTLEVEL > 0 THEN NESTLEVEL := NESTLEVEL - 1; SOLNEST := NESTLEVEL;
  184.     UNTIL SY IN [PROCSY,BEGINSY,ENDOFILE];
  185. END;
  186.  
  187. PROCEDURE PARAMETERLIST; {enter --> (  ; leave past  )    }
  188. VAR PLEV : INTEGER; ENTNL:INTEGER;
  189. BEGIN
  190.   PLEV := 0; ENTNL := NESTLEVEL; 
  191.   IF QUANTUM <> 0 THEN NESTLEVEL := NESTLEVEL + CHCNT / QUANTUM;
  192.   INSYM;
  193.   REPEAT
  194.     IF SY = LPAREN THEN PLEV := PLEV + 1 ELSE
  195.       IF SY = RPAREN THEN PLEV := PLEV - 1;
  196.     INSYM;
  197.   UNTIL ((PLEV=0) AND (SY = RPAREN)) OR EOF;
  198.   NESTLEVEL := ENTNL; INSYM;
  199. END;
  200.  
  201.  
  202. PROCEDURE BLOCK; {enter -->begin; leave just past end}
  203. VAR ENTNL,SOLNL:INTEGER;
  204. BEGIN
  205.   ENTNL := NESTLEVEL; SOLNL := SOLNEST;
  206.   NESTLEVEL := NESTLEVEL + 1;
  207.   REPEAT
  208.     INSYM;
  209.     IF SY IN [IFSY,WHILESY,FORSY] THEN NESTLEVEL := NESTLEVEL+1 ELSE
  210.       IF SY IN [BEGINSY,REPEATSY,CASESY,LBRACK] THEN BLOCK;
  211.     IF SY = SEMI THEN NESTLEVEL := ENTNL+1;
  212.   UNTIL SY IN [ENDSY,UNTILSY,RBRACK,ENDOFILE];
  213.   NESTLEVEL := ENTNL; SOLNEST := SOLNL;
  214.   IF SY = UNTILSY THEN
  215.     REPEAT
  216.       INSYM;
  217.       IF SY = LBRACK THEN 
  218.         BEGIN REPEAT INSYM UNTIL (SY = RBRACK) OR EOF; INSYM; END;
  219.     UNTIL SY IN [SEMI,ENDSY,RBRACK,ELSESY,UNTILSY,ENDOFILE]
  220.    ELSE INSYM;
  221. END;
  222.  
  223. {------------------------------------------------------------------------}
  224.  
  225. BEGIN
  226.   QUANTUM := 2;
  227.   INDENT := 0;  NESTLEVEL := 0;  SOLNEST := 0;  MAKEUC := TRUE;
  228.   FIRSTSY := FIRST1;  CHCNT := 0; NEXTCH;
  229.   REPEAT INSYM UNTIL SY IN [BEGINSY,PROCSY,DECLSY,ENDOFILE];
  230.   DECLARATIONS;  {global}
  231.   REPEAT
  232.     IF SY = PROCSY THEN
  233.       BEGIN
  234.         REPEAT INSYM UNTIL SY IN [SEMI,LPAREN,ENDOFILE];
  235.         IF SY = LPAREN THEN PARAMETERLIST;
  236.         NOBLOCK := FALSE;
  237.         REPEAT
  238.           INSYM;
  239.           IF SY = NOBLKSYS THEN NOBLOCK := TRUE; {forward, extern, external}
  240.         UNTIL SY IN [BEGINSY,PROCSY,DECLSY,ENDOFILE];
  241.         DECLARATIONS;
  242.         IF NOT NOBLOCK THEN NESTLEVEL := NESTLEVEL + 1; SOLNEST := NESTLEVEL;
  243.       END;
  244.     IF SY = BEGINSY THEN
  245.       BEGIN
  246.         IF NESTLEVEL > 0 THEN NESTLEVEL := NESTLEVEL-1;
  247.         SOLNEST := NESTLEVEL;
  248.         BLOCK;
  249.         WHILE NOT (SY IN [BEGINSY,PROCSY,ENDOFILE]) DO INSYM;
  250.       END;
  251.   UNTIL SY = ENDOFILE;
  252. END.
  253.