home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASUTIL1.ZIP / PARTA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  14.5 KB  |  387 lines
  1. PROGRAM PRETTYPRINT (* FROM PROGIN TO PROGOUT *); 
  2. CONST
  3.       MAXSYMBOLSIZE = 200; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)
  4.                            (* SYMBOL SCANNED BY THE LEXICAL SCANNER.  *)
  5.       MAXSTACKSIZE  = 100; (* THE MAXIMUM NUMBER OF SYMBOLS CAUSING   *)
  6.                            (* INDENTATION THAT MAY BE STACKED.        *)
  7.       MAXKEYLENGTH  =  10; (* THE MAXIMUM LENGTH (IN CHARACTERS) OF A *)
  8.                            (* PASCAL RESERVED KEYWORD.                *)
  9.       MAXLINESIZE   =  79; (* THE MAXIMUM SIZE (IN CHARACTERS) OF A   *)
  10.                            (* LINE OUTPUT BY THE PRETTYPRINTER.       *)
  11.       SLOFAIL1      =  77; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
  12.                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
  13.                            (* WILL BE INDENTED BY "INDENT1".          *)
  14.       SLOFAIL2      =  79; (* UP TO THIS COLUMN POSITION, EACH TIME   *)
  15.                            (* "INDENTBYTAB" IS INVOKED, THE MARGIN    *)
  16.                            (* WILL BE INDENTED BY "INDENT2".  BEYOND  *)
  17.                            (* THIS, NO INDENTATION OCCURS.            *)
  18.       INDENT1       =   2;
  19.       INDENT2       =   1;
  20.       SPACE = ' ';
  21. TYPE
  22.      KEYSYMBOL = ( PROGSYM,    FUNCSYM,     PROCSYM,
  23.                    LABELSYM,   CONSTSYM,    TYPESYM,   VARSYM,
  24.                    BEGINSYM,   REPEATSYM,   RECORDSYM,
  25.                    CASESYM,    CASEVARSYM,  OFSYM,
  26.                    FORSYM,     WHILESYM,    WITHSYM,   DOSYM,
  27.                    IFSYM,      THENSYM,     ELSESYM,
  28.                    ENDSYM,     UNTILSYM,
  29.                    BECOMES,    OPENCOMMENT, CLOSECOMMENT,
  30.                    SEMICOLON,  COLON,       EQUALS,
  31.                    OPENPAREN,  CLOSEPAREN,  PERIOD,
  32.                    ENDOFFILE,
  33.                    OTHERSYM );
  34.      OPTION = ( CRSUPPRESS,
  35.                 CRBEFORE,
  36.                 BLANKLINEBEFORE,
  37.                 DINDENTONKEYS,
  38.                 DINDENT,
  39.                 SPACEBEFORE,
  40.                 SPACEAFTER,
  41.                 GOBBLESYMBOLS,
  42.                 INDENTBYTAB,
  43.                 INDENTTOCLP,
  44.                 CRAFTER );
  45.      OPTIONSET = SET OF OPTION;
  46.      KEYSYMSET = SET OF KEYSYMBOL;
  47.      TABLEENTRY = RECORD
  48.                      OPTIONSSELECTED  : OPTIONSET;
  49.                      DINDENTSYMBOLS   : KEYSYMSET;
  50.                      GOBBLETERMINATORS: KEYSYMSET
  51.                   END;
  52.      OPTIONTABLE = ARRAY [ KEYSYMBOL ] OF TABLEENTRY;
  53.      KEY = PACKED ARRAY [ 1..MAXKEYLENGTH ] OF CHAR;
  54.      KEYWORDTABLE = ARRAY [ PROGSYM..UNTILSYM ] OF KEY;
  55.      SPECIALCHAR = PACKED ARRAY [ 1..2 ] OF CHAR;
  56.      DBLCHRSET = SET OF BECOMES..OPENCOMMENT;
  57.      DBLCHARTABLE = ARRAY [ BECOMES..OPENCOMMENT ] OF SPECIALCHAR;
  58.      SGLCHARTABLE = ARRAY [ SEMICOLON..PERIOD ] OF CHAR;
  59.      STRINGY = ARRAY [ 1..MAXSYMBOLSIZE ] OF CHAR;
  60.      SYMBOL = RECORD
  61.                  NAME        : KEYSYMBOL;
  62.                  VALYOO       : STRINGY;
  63.                  LENGTH      : INTEGER;
  64.                  SPACESBEFORE: INTEGER;
  65.                  CRSBEFORE   : INTEGER
  66.               END;
  67.      SYMBOLINFO = ^SYMBOL;
  68.      CHARNAME = ( LETTER,    DIGIT,    BLANK,    QUOTE,
  69.                   ENDOFLINE, FILEMARK, OTHERCHAR       );
  70.      CHARINFO = RECORD
  71.                    NAME : CHARNAME;
  72.                    VALYOO: CHAR
  73.                 END;
  74.      STACKENTRY = RECORD
  75.                      INDENTSYMBOL: KEYSYMBOL;
  76.                      PREVMARGIN  : INTEGER
  77.                   END;
  78.      SYMBOLSTACK = ARRAY [ 1..MAXSTACKSIZE ] OF STACKENTRY;
  79. VAR 
  80.      SAWCOMOPEN, SAWCOMCLOSE, SAWQUOTEDSTRING, INACOMMENT    : BOOLEAN; 
  81.      PROGIN, PROGOUT : STRING(20);
  82.     RECORDSEEN: BOOLEAN;
  83.     CURRCHAR,
  84.     NEXTCHAR: CHARINFO;
  85.     CURRSYM,
  86.     NEXTSYM: SYMBOLINFO;
  87.     CRPENDING: BOOLEAN;
  88.     PPOPTION: OPTIONTABLE;
  89.     KEYWORD: KEYWORDTABLE;
  90.     DBLCHARS: DBLCHRSET;
  91.     DBLCHAR: DBLCHARTABLE;
  92.     SGLCHAR: SGLCHARTABLE;
  93.     STACK: SYMBOLSTACK;
  94.     TOP  : INTEGER;
  95.     STARTPOS,           (* STARTING POSITION OF LAST SYMBOL WRITTEN *)
  96.     CURRLINEPOS,
  97.     CURRMARGIN :  INTEGER;
  98.  FIN, FOUT  : TEXT;
  99. PROCEDURE GETCHAR(
  100.                    (* UPDATING *)  VAR NEXTCHAR  : CHARINFO;
  101.                    (* RETURNING *) VAR CURRCHAR  : CHARINFO );
  102. BEGIN (* GETCHAR *)
  103.    CURRCHAR := NEXTCHAR;
  104.    WITH NEXTCHAR DO
  105.       BEGIN
  106.          IF EOF(FIN)
  107.             THEN
  108.                NAME  := FILEMARK
  109.     ELSE IF EOLN(FIN)
  110.             THEN
  111.                NAME  := ENDOFLINE
  112.  ELSE IF ( ( FIN^ IN [ 'a' .. 'z'] ) AND  (NOT SAWQUOTEDSTRING) )
  113.  THEN BEGIN
  114.    FIN^ := CHR ( ORD ( FIN^ ) - 32 );
  115.    NAME := LETTER
  116.  END
  117.  ELSE IF SAWCOMOPEN THEN
  118.  BEGIN
  119.    SAWCOMOPEN := FALSE;
  120.    FIN^ := '*';
  121.    NAME := OTHERCHAR
  122.  END
  123.  ELSE IF SAWCOMCLOSE THEN
  124.    BEGIN
  125.    SAWCOMCLOSE := FALSE;
  126.    FIN^ := ')';
  127.    NAME := OTHERCHAR
  128.    END
  129.  ELSE IF FIN^ = '{' THEN
  130.    BEGIN
  131.    SAWCOMOPEN := TRUE;
  132.    INACOMMENT := TRUE;
  133.    FIN^ := '(';
  134.    NAME := OTHERCHAR
  135.    END 
  136.  ELSE IF FIN^ = '}' THEN
  137.    BEGIN
  138.      SAWCOMCLOSE := TRUE;
  139.      INACOMMENT := FALSE;
  140.      FIN^ := '*';
  141.      NAME := OTHERCHAR
  142.    END
  143.     ELSE IF FIN^ IN ['A' .. 'Z'] THEN
  144.                NAME  := LETTER
  145.     ELSE IF FIN^ IN ['0'..'9'] THEN
  146.                NAME  := DIGIT
  147.  ELSE IF ( FIN^ = '''') AND ( NOT INACOMMENT ) THEN
  148.  IF SAWQUOTEDSTRING THEN
  149.    BEGIN
  150.      NAME := QUOTE;
  151.      SAWQUOTEDSTRING := FALSE
  152.    END
  153.  ELSE
  154.    BEGIN
  155.      NAME := QUOTE;
  156.      SAWQUOTEDSTRING := TRUE
  157.    END
  158.      ELSE IF FIN^ = SPACE THEN
  159.                NAME  := BLANK
  160.     ELSE NAME := OTHERCHAR;
  161.          IF NAME IN [ FILEMARK, ENDOFLINE ] THEN
  162.                VALYOO := SPACE
  163.          ELSE
  164.                VALYOO := FIN^;
  165.          IF (NAME <> FILEMARK) AND (NOT SAWCOMOPEN) AND (NOT SAWCOMCLOSE)
  166.             THEN GET(FIN)
  167.       END (* WITH *)
  168. END; (* GETCHAR *)
  169. PROCEDURE STORENEXTCHAR(
  170.                          (* UPDATING *)    VAR LENGTH    : INTEGER;
  171.                                            VAR CURRCHAR,
  172.                                                NEXTCHAR  : CHARINFO;
  173.                          (* PLACING IN *)  VAR VALYOO     : STRINGY   );
  174. BEGIN (* STORENEXTCHAR *)
  175.    GETCHAR(
  176.             (* UPDATING *)  NEXTCHAR,
  177.             (* RETURNING *) CURRCHAR  );
  178.    IF LENGTH < MAXSYMBOLSIZE THEN
  179.          BEGIN
  180.             LENGTH := LENGTH + 1;
  181.             VALYOO [LENGTH] := CURRCHAR.VALYOO
  182.          END
  183. END; (* STORENEXTCHAR *)
  184. PROCEDURE SKIPSPACES(
  185.                       (* UPDATING *)  VAR CURRCHAR,
  186.                                           NEXTCHAR     : CHARINFO;
  187.                       (* RETURNING *) VAR SPACESBEFORE,
  188.                                           CRSBEFORE    : INTEGER  );
  189. BEGIN (* SKIPSPACES *)
  190.    SPACESBEFORE := 0;
  191.    CRSBEFORE    := 0;
  192.    WHILE NEXTCHAR.NAME IN [ BLANK, ENDOFLINE ] DO
  193.       BEGIN
  194.          GETCHAR(
  195.                   (* UPDATING *)  NEXTCHAR,
  196.                   (* RETURNING *) CURRCHAR  );
  197.          CASE CURRCHAR.NAME OF
  198.             BLANK     : SPACESBEFORE := SPACESBEFORE + 1;
  199.              ENDOFLINE : BEGIN
  200.                            CRSBEFORE    := CRSBEFORE + 1;
  201.                            SPACESBEFORE := 0
  202.                         END
  203.          END (* CASE *)
  204.       END (* WHILE *)
  205. END; (* SKIPSPACES *)
  206. PROCEDURE GETCOMMENT(
  207.                       (* UPDATING *) VAR CURRCHAR,
  208.                                          NEXTCHAR  : CHARINFO;
  209.                                      VAR NAME      : KEYSYMBOL;
  210.                                      VAR VALYOO     : STRINGY;
  211.                                      VAR LENGTH    : INTEGER   );
  212. BEGIN (* GETCOMMENT *)
  213.  INACOMMENT := TRUE;
  214.    NAME := OPENCOMMENT;
  215.    WHILE NOT(    ((CURRCHAR.VALYOO = '*') AND (NEXTCHAR.VALYOO = ')'))
  216.               OR (NEXTCHAR.NAME = ENDOFLINE)
  217.               OR (NEXTCHAR.NAME = FILEMARK)) DO
  218.       STORENEXTCHAR(
  219.                      (* UPDATING *) LENGTH,
  220.                                     CURRCHAR,
  221.                                     NEXTCHAR,
  222.                      (* IN *)       VALYOO     );
  223.    IF (CURRCHAR.VALYOO = '*') AND (NEXTCHAR.VALYOO = ')') THEN
  224.          BEGIN
  225.             STORENEXTCHAR(
  226.                            (* UPDATING *) LENGTH,
  227.                                           CURRCHAR,
  228.                                           NEXTCHAR,
  229.                            (* IN *)       VALYOO     );
  230.             NAME := CLOSECOMMENT;
  231.             INACOMMENT := FALSE
  232.          END
  233. END; (* GETCOMMENT *)
  234. FUNCTION IDTYPE( (* OF *)        VALYOO  : STRINGY;
  235.                  (* USING *)     LENGTH : INTEGER )
  236.                  (* RETURNING *)                   : KEYSYMBOL;
  237. VAR
  238.     I: INTEGER;
  239.     KEYVALYOO: KEY;
  240.     HIT: BOOLEAN;
  241.     THISKEY: KEYSYMBOL;
  242. BEGIN (* IDTYPE *)
  243.    IDTYPE := OTHERSYM;
  244.    IF LENGTH <= MAXKEYLENGTH THEN
  245.          BEGIN
  246.             FOR I := 1 TO LENGTH DO
  247.                KEYVALYOO [I] := VALYOO [I];
  248.             FOR I := LENGTH+1 TO MAXKEYLENGTH DO
  249.                KEYVALYOO [I] := SPACE;
  250.             THISKEY := PROGSYM;
  251.             HIT     := FALSE;
  252.             WHILE NOT(HIT OR (THISKEY = SUCC(UNTILSYM))) DO
  253.                IF KEYVALYOO = KEYWORD [THISKEY] THEN
  254.                  HIT := TRUE
  255.                ELSE
  256.                  THISKEY := SUCC(THISKEY);
  257.             IF HIT THEN IDTYPE := THISKEY
  258.          END;
  259. END; (* IDTYPE *)
  260. PROCEDURE GETIDENTIFIER(
  261.                          (* UPDATING *)  VAR CURRCHAR,
  262.                                              NEXTCHAR  : CHARINFO;
  263.                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
  264.                                          VAR VALYOO     : STRINGY;
  265.                                          VAR LENGTH    : INTEGER   );
  266. BEGIN (* GETIDENTIFIER *)
  267.    WHILE NEXTCHAR.NAME IN [ LETTER, DIGIT ] DO
  268.       STORENEXTCHAR( (* UPDATING *) LENGTH,
  269.                                     CURRCHAR,
  270.                                     NEXTCHAR,
  271.                      (* IN *)       VALYOO     );
  272.    NAME := IDTYPE( (* OF *) VALYOO, (* USING *) LENGTH );
  273.    IF NAME IN [ RECORDSYM, CASESYM, ENDSYM ] THEN
  274.          CASE NAME OF
  275.             RECORDSYM : RECORDSEEN := TRUE;
  276.             CASESYM   : IF RECORDSEEN THEN
  277.                               NAME := CASEVARSYM;
  278.             ENDSYM    : RECORDSEEN := FALSE
  279.          END (* CASE *)
  280. END; (* GETIDENTIFIER *)
  281. PROCEDURE GETNUMBER(
  282.                      (* UPDATING *)  VAR CURRCHAR,
  283.                                          NEXTCHAR  : CHARINFO;
  284.                      (* RETURNING *) VAR NAME      : KEYSYMBOL;
  285.                                      VAR VALYOO     : STRINGY;
  286.                                      VAR LENGTH    : INTEGER   );
  287. BEGIN (* GETNUMBER *)
  288.    WHILE NEXTCHAR.NAME = DIGIT DO
  289.       STORENEXTCHAR(
  290.                      (* UPDATING *) LENGTH,
  291.                                     CURRCHAR,
  292.                                     NEXTCHAR,
  293.                      (* IN *)       VALYOO     );
  294.    NAME := OTHERSYM
  295. END; (* GETNUMBER *)
  296.                   PROCEDURE GETCHARLITERAL(
  297.                           (* UPDATING *)  VAR CURRCHAR,
  298.                                               NEXTCHAR  : CHARINFO;
  299.                           (* RETURNING *) VAR NAME      : KEYSYMBOL;
  300.                                           VAR VALYOO     : STRINGY;
  301.                                           VAR LENGTH    : INTEGER   );
  302. BEGIN (* GETCHARLITERAL *)
  303.    WHILE NEXTCHAR.NAME = QUOTE DO
  304.       BEGIN
  305.          STORENEXTCHAR(
  306.                         (* UPDATING *) LENGTH,
  307.                                        CURRCHAR,
  308.                                        NEXTCHAR,
  309.                         (* IN *)       VALYOO     );
  310.          WHILE NOT(NEXTCHAR.NAME IN [ QUOTE, ENDOFLINE, FILEMARK ]) DO
  311.             STORENEXTCHAR(
  312.                            (* UPDATING *) LENGTH,
  313.                                           CURRCHAR,
  314.                                           NEXTCHAR,
  315.                            (* IN *)       VALYOO     );
  316.          IF NEXTCHAR.NAME = QUOTE
  317.             THEN
  318.                               STORENEXTCHAR(
  319.                               (* UPDATING *) LENGTH,
  320.                                              CURRCHAR,
  321.                                              NEXTCHAR,
  322.                               (* IN *)       VALYOO     )
  323.       END;
  324.    NAME := OTHERSYM
  325. END; (* GETCHARLITERAL *)
  326. FUNCTION CHARTYPE( (* OF *)        CURRCHAR,
  327.                                    NEXTCHAR : CHARINFO )
  328.                    (* RETURNING *) : KEYSYMBOL;
  329. VAR
  330.     NEXTTWOCHARS: SPECIALCHAR;
  331.     HIT: BOOLEAN;
  332.     THISCHAR: KEYSYMBOL;
  333. BEGIN (* CHARTYPE *)
  334.    NEXTTWOCHARS[1] := CURRCHAR.VALYOO;
  335.    NEXTTWOCHARS[2] := NEXTCHAR.VALYOO;
  336.    THISCHAR := BECOMES;
  337.    HIT      := FALSE;
  338.    WHILE NOT(HIT OR (THISCHAR = CLOSECOMMENT)) DO
  339.       IF NEXTTWOCHARS = DBLCHAR [THISCHAR] THEN
  340.         HIT := TRUE
  341.       ELSE
  342.         THISCHAR := SUCC(THISCHAR);
  343.    IF NOT HIT THEN
  344.          BEGIN
  345.             THISCHAR := SEMICOLON;
  346.             WHILE NOT(HIT OR (PRED(THISCHAR) = PERIOD)) DO
  347.               IF CURRCHAR.VALYOO = SGLCHAR [THISCHAR] THEN
  348.                 HIT := TRUE
  349.               ELSE
  350.                 THISCHAR := SUCC(THISCHAR)
  351.          END;
  352.    IF HIT THEN
  353.      CHARTYPE := THISCHAR
  354.    ELSE
  355.      CHARTYPE := OTHERSYM
  356. END; (* CHARTYPE *)
  357. PROCEDURE GETSPECIALCHAR(
  358.                           (* UPDATING *)  VAR CURRCHAR,
  359.                                               NEXTCHAR  : CHARINFO;
  360.                           (* RETURNING *) VAR NAME      : KEYSYMBOL;
  361.                                           VAR VALYOO     : STRINGY;
  362.                                           VAR LENGTH    : INTEGER   );
  363. BEGIN (* GETSPECIALCHAR *)
  364.    STORENEXTCHAR(
  365.                   (* UPDATING *) LENGTH,
  366.                                  CURRCHAR,
  367.                                  NEXTCHAR,
  368.                   (* IN *)       VALYOO     );
  369.    NAME := CHARTYPE( (* OF *) CURRCHAR,
  370.                               NEXTCHAR );
  371.    IF NAME IN DBLCHARS
  372.       THEN
  373.          STORENEXTCHAR(
  374.                           (* UPDATING *) LENGTH,
  375.                                        CURRCHAR,
  376.                                        NEXTCHAR,
  377.                         (* IN *)       VALYOO     )
  378. END; (* GETSPECIALCHAR *)
  379. PROCEDURE GETNEXTSYMBOL(
  380.                          (* UPDATING *)  VAR CURRCHAR,
  381.                                              NEXTCHAR  : CHARINFO;
  382.                          (* RETURNING *) VAR NAME      : KEYSYMBOL;
  383.                                          VAR VALYOO     : STRINGY;
  384.                                          VAR LENGTH    : INTEGER   );
  385. BEGIN (* GETNEXTSYMBOL *)
  386.    CASE NEXTCHAR.NAME OF
  387.