path: root/support/pp/pp.mod

(*
%%% ====================================================================
%%%  @TeX-Utility{
%%%     filename        = "pp.exe",
%%%     version         = "1.01",
%%%     date            = "16 Feb 1994",
%%%     time            = "11:01:23 BST",
%%%     author          = "Mike Piff",
%%%     address         = "Dr M. J. Piff
%%%                       University of Sheffield
%%%                       School of Mathematics and Statistics
%%%                       Hicks Building
%%%                       Hounsfield Road
%%%                       SHEFFIELD S3 7RH
%%%                       England",
%%%     telephone       = "+44 742 824431",
%%%     email           = "M.Piff@sheffield.ac.uk (Janet)",
%%%     keywords        = "Pascal,Modula2,formatting",
%%%     supported       = "yes",
%%%     checksum        = "",
%%%     docstring       = "
%%%                PP is a program that takes a Modula-2 or Pascal
%%%                program, and converts it into a \LaTeX/plain \TeX\ file
%%%                ready to input into your document.
%%%                The source code is included in this distribution,
%%%                together with an MS-DOS executable.
%%%
%%%                As Modula-2 is case-sensitive, whereas Pascal is not,
%%%                it is necessary to inform the program which language is
%%%                being used. Two customization files MOD.RES and PAS.RES
%%%                are included. It is possible that customization files
%%%                can be built for other languages too---I haven't tried,
%%%                but please let me know if you produce any.
%%%                The format of each file is
%%%
%%%                No. of keywords
%%%                optional * to indicate case-insensitive
%%%                list of keywords
%%%
%%%                The first thing the program does is prompt for the list of
%%%                keywords. After that it asks for an input file and an output
%%%                file, and that is it!
%%%
%%%                ...almost. One problem with this kind of listing is that
%%%                \TeX\ has trouble breaking a program at a meaningful place,
%%%                eg, after declarations. Thus, we need to give it some clues.
%%%                A BLANK LINE in the input indicates a good breakpoint, but
%%%                DOES NOT result in blank lines in the output. However,
%%%                n>1 blank lines result in n-1 blank output lines. Thus,
%%%                space your program carefully!
%%%
%%%                Another problem is the way that Modula-2 and Pascal delimit
%%%                comments. Whereas Wirth used [ ] for sets in Pascal,
%%%                contrary to all mathematical practices, and { } or ({}* *{})
%%%                for comments, in Modula-2 he
%%%                reserved { } for sets. Thus, the results will look better
%%%                if you use ({}* *{}) for comments in Pascal rather than
%%%                { }. Maybe this could be added to the customization file,
%%%                but I haven't found the need yet.
%%%
%%%                To make your comments come out reasonable, assume that you
%%%                are in horizontal (text) mode inbetween ({}* and *{}). Thus,
%%%                write
%%%                (* and so $2^n\geq\log m$ *)
%%%                rather than
%%%                ({}* and so 2$\uparrow$n>= log m *{})
%%%                If you want to include a bit of code inside a comment,
%%%                precede it and follow it by **. Thus
%%%                ({}* Or use
%%%                **
%%%                  PROCEDURE xxx;FORWARD;
%%%                **
%%%                if yours is a single pass compiler *{})
%%%
%%%                The output of PP is similar to that of WEB, say, but your
%%%                program is free-standing and you do not need to learn to
%%%                use WEB. Generally, horizontal spacing is respected in the
%%%                output, but you should use spaces rather than tabs for this
%%%                to work. I have used := rather than <- for assignments.
%%%                 ",
%%%  }
%%% ====================================================================
*)
MODULE PP;

FROM InOut IMPORT OpenInput, CloseInput, EOL, Read, Write, WriteLn,
   ReadCard, OpenOutput, CloseOutput, ReadString, WriteString, Done;

CONST
  minnestinglevel=0; maxnestinglevel=100;
  minlineindex=0; maxlineindex=4000;
  minidentindex=0; maxidentindex=99;

  zero='0'; seven='7'; nine='9';
  ampersand='&'; lbrace='{'; rbrace='}';
  caret='^'; bar='|'; tilde='~';
  equalch='='; squote="'"; dquote='"';
  less='<'; greater='>'; space=' ';
  hatch='#'; period='.';
  plusch='+'; minusch='-'; star='*';
  colonch=':'; underscore='_';
  lpar='('; rpar=')'; tab=11C; eof=32C;

TYPE
  identlengths=CARDINAL[minidentindex..maxidentindex];

  nonterminals=(Next,
    integernum,realnum,realexpt,realp,
    realdots,octno,charno,hexno,
    dot,dots,becomes,colon,
    identifier,lt,leq,gt,geq,neq,
    plus,minus,equal,logand,
    bset,eset,deref,lognot,logor,
    leftpar,starcom,bcomment,ecomment,stars,
    other,sstrg,dstrg,spaces,
    (* the rest are transient states *)
    Fail,reale,realepm,oct,hex,
    sqstring,dqstring);

  terminals=CHAR;
  states=ARRAY nonterminals OF BOOLEAN;
  indices=CARDINAL[minlineindex..maxlineindex];
  stringarrays=ARRAY indices OF terminals;

  lines=RECORD
    chr:stringarrays;
    start,posn:indices;
  END;

  modes=(texmode,progmode);
  nestinglevels=CARDINAL[minnestinglevel..maxnestinglevel];
  modesatlevels=ARRAY nestinglevels OF modes;

VAR
  line:lines;
  EOF:BOOLEAN;
  commtlev:nestinglevels;
  modeatlevel:modesatlevels;

PROCEDURE BeginProgram;
BEGIN
  WriteString('\par\begingroup\parindent=0pt{}\parskip=0pt plus1pt\relax');
  WriteLn;
  WriteString('\obeylines\obeyspaces\def {\hskip0.3em\relax}%');WriteLn;
END BeginProgram;

PROCEDURE EndProgram;
BEGIN
  WriteString('\endgroup%'); WriteLn;
END EndProgram;

MODULE TableHandler;
IMPORT identlengths, lines, minidentindex, maxidentindex,
   WriteString, WriteLn, OpenInput, CloseInput, ReadCard, Read;
EXPORT reserved;

CONST
  minresw=0;  maxresw=100;
  minrwlength=0; maxrwlength=32;
  space=' '; star='*';

TYPE
  resnos=CARDINAL[minresw..maxresw];
  rwlengths=CARDINAL[minrwlength..maxrwlength];
  reservedwords=ARRAY rwlengths OF CHAR;
  tables=ARRAY resnos OF reservedwords;
  identifierstrings=ARRAY identlengths OF CHAR;

VAR
  table:tables;
  lastresw:resnos;
  upcase:BOOLEAN;

  PROCEDURE SetUpTable(VAR table:tables);
  VAR
    i:CARDINAL;
    k:resnos;

  PROCEDURE ReadReserved(VAR r:reservedwords);
  VAR
    i:rwlengths;
    ch:CHAR;

  BEGIN
    i:=minrwlength;
    REPEAT Read(ch) UNTIL ch>space;
    IF ch=star THEN
      upcase:=TRUE;
      REPEAT Read(ch) UNTIL ch>space;
    END;
    WHILE  ch>space DO
      r[i]:=ch;
      INC(i);
      Read(ch);
    END;
    r[i]:=0C;
  END ReadReserved;

  BEGIN
    WriteString('PP Copyright (C) 1992 by Mike Piff, ');
    WriteString('10/29/92 01:27pm');
    WriteLn;
    WriteString('Input filename for reserved words');WriteLn;
    OpenInput('RES');
    ReadCard(i); lastresw:=resnos(i+minresw-1);
    upcase:=FALSE;

    FOR k:=minresw TO lastresw DO
      ReadReserved(table[k]);
    END;
    CloseInput;
  END SetUpTable;

  PROCEDURE reserved(VAR e:lines):BOOLEAN;
  VAR
    s:identifierstrings;
    min,max,test:resnos;
    i:CARDINAL;

  TYPE
    orders=(lessthan,equalto,greaterthan);

    PROCEDURE order(VAR s1,s2:ARRAY OF CHAR):orders;
    VAR
      i:CARDINAL;

    BEGIN
      i:=0;
      LOOP
        IF (s1[i]<s2[i]) THEN RETURN lessthan; EXIT;
        ELSIF (s1[i]>s2[i]) THEN RETURN greaterthan; EXIT;
        ELSIF (s1[i]=0C) & (s2[i]=0C) THEN RETURN equalto; EXIT;
        END;
        INC(i);
      END;
    END order;

  VAR
    ch,cch:CHAR;

  BEGIN
    WITH e DO
      FOR i:=start TO posn-1 DO
        ch:=chr[i]; cch:=CAP(ch);
        IF (cch<'A') OR (cch>'Z') THEN RETURN FALSE; END;
        IF upcase THEN
          s[i-start]:=cch;
        ELSE
          s[i-start]:=ch;
        END;
      END;
      s[posn-start]:=0C;
    END;

    min:=minresw; max:=lastresw;

    LOOP
      IF (min>max) THEN RETURN FALSE; END;
      test:=(min+max)DIV 2;
      CASE order(s,table[test]) OF
        lessthan:
          IF test=minresw THEN
            RETURN FALSE;
          ELSE
            max:=test-1;
          END;|
        equalto:
          RETURN TRUE;|
        greaterthan:
          IF test=lastresw THEN
            RETURN FALSE;
          ELSE
            min:=test+1;
          END;
      END;
    END;
  END reserved;

BEGIN
  SetUpTable(table);
END TableHandler;

PROCEDURE ReadLine(VAR s:ARRAY OF CHAR);
CONST Ignorech=12C;

VAR i:CARDINAL;  ch:CHAR;

BEGIN
  s[0]:=0C; EOF:=FALSE; i:=minlineindex;

  LOOP
    IF i>(HIGH(s)-1) THEN EXIT END;
    Read(ch);
    IF ch<>Ignorech THEN
      IF ch=EOL THEN EXIT END;
      IF ch=eof THEN EOF:=TRUE;EXIT END;
      IF ~Done THEN EOF:=TRUE;EXIT END;
      IF ch=tab THEN ch:=space; END;
      s[i]:=ch; INC(i);
    END;
  END;
  s[i]:=0C;
END ReadLine;

PROCEDURE Clear(VAR s:states);
VAR
  n:nonterminals;

BEGIN
  FOR n:=MIN(nonterminals) TO MAX(nonterminals) DO
    s[n]:=FALSE;
  END;
END Clear;

PROCEDURE Initialise(VAR e:lines);
BEGIN
  WITH e DO
    posn:=minlineindex; start:=minlineindex;
  END;
END Initialise;

PROCEDURE MakeTransition(VAR state:states;t:terminals;VAR made:BOOLEAN;
  VAR nt:nonterminals);
VAR
  newstate:states;
  n:nonterminals;

  PROCEDURE digit(t:terminals):BOOLEAN;
  BEGIN
    RETURN (t>=zero) & (t<=nine);
  END digit;

  PROCEDURE octal(t:terminals):BOOLEAN;
  BEGIN
    RETURN (t>=zero) & (t<=seven);
  END octal;

  PROCEDURE hexadecimal(t:terminals):BOOLEAN;
  BEGIN
    t:=CAP(t);
    RETURN ((t>=zero) & (t<=nine)) OR ((t>='A') & (t<='F'));;
  END hexadecimal;

  PROCEDURE letter(t:terminals):BOOLEAN;
  BEGIN
    t:=CAP(t);RETURN(((t>='A') & (t<='Z')) OR (t=underscore));
  END letter;

  PROCEDURE setstate(t:nonterminals);
  BEGIN
    newstate[t]:=TRUE;made:=TRUE;nt:=t;
  END setstate;

BEGIN
  Clear(newstate); made:=FALSE;
  IF modeatlevel[commtlev]=texmode THEN
    FOR n:=MIN(nonterminals) TO MAX(nonterminals) DO
      IF state[n] THEN
        CASE n OF
          Next:
            IF t=star THEN
              setstate(starcom);

            ELSIF t=lbrace THEN
              setstate(bset);
            ELSE
              setstate(other);
            END;|

          leftpar: IF t=star THEN setstate(bcomment);  END;|

          starcom:
            IF t=rpar THEN setstate(ecomment);
            ELSIF t=star THEN setstate(stars);
            END;|

          stars: IF t=star THEN setstate(stars); END;
        ELSE
        END;
      END;
    END

  ELSE
    FOR n:=MIN(nonterminals) TO MAX(nonterminals) DO
      IF state[n] THEN
        CASE n OF
          Next:
            IF digit(t) THEN
              setstate(integernum); setstate(hex);
              IF octal(t) THEN setstate(oct); END;
            ELSIF letter(t) THEN setstate(identifier);

            ELSE
              CASE t OF
                less: setstate(lt);|

                plusch: setstate(plus);|

                minusch: setstate(minus);|

                equalch: setstate(equal);|

                ampersand: setstate(logand);|

                lbrace: setstate(bset);|

                rbrace: setstate(eset);|

                caret: setstate(deref);|

                tilde: setstate(lognot);|

                bar: setstate(logor);|

                greater: setstate(gt);|

                hatch: setstate(neq);|

                lpar: setstate(leftpar);|

                star: setstate(starcom);|

                period: setstate(dot);|

                squote: setstate(sqstring);|

                dquote: setstate(dqstring);|

                colonch: setstate(colon);
              ELSE setstate(other);
              END;
            END;|
          integernum:
            IF digit(t) THEN setstate(integernum);
            ELSIF t=period THEN setstate(realp);
            END;|

          realp:
            IF t=period THEN setstate(realdots);
            ELSIF digit(t) THEN setstate(realnum);
            ELSIF t='E' THEN setstate(reale);
            END;|

          oct:
            IF octal(t) THEN setstate(oct);
            ELSIF CAP(t)='B' THEN setstate(octno);
            ELSIF CAP(t)='C' THEN setstate(charno);
            END;|

          hex:
            IF hexadecimal(t) THEN setstate(hex);
            ELSIF CAP(t)='H' THEN setstate(hexno);
            END;|

          realnum:
            IF digit(t) THEN setstate(realnum);
            ELSIF t='E' THEN setstate(reale);
            END;|

          reale:
            IF digit(t) THEN setstate(realexpt);
            ELSIF (t=plusch) OR (t=minusch) THEN setstate(realepm);
            END;|

          realepm:
            IF digit(t) THEN setstate(realexpt); END;|

          realexpt:
            IF digit(t) THEN setstate(realexpt); END;|

          dot:
            IF t=period THEN setstate(dots); END;|

          identifier:
            IF digit(t) OR letter(t) THEN setstate(identifier); END;|

          lt:
            IF t=equalch THEN setstate(leq);
            ELSIF t=greater THEN setstate(neq);
            END;|

          gt:
            IF t=equalch THEN setstate(geq); END;|

          leftpar:
            IF t=star THEN setstate(bcomment);  END;|

          starcom:
            IF t=rpar THEN setstate(ecomment);
            ELSIF t=star THEN setstate(stars);
            END;|

          stars: IF t=star THEN setstate(stars); END;|

          sqstring:
            IF t=squote THEN
              setstate(sstrg);
            ELSE
              setstate(sqstring);
            END;|

          dqstring:
            IF t=dquote THEN
              setstate(dstrg);
            ELSE
              setstate(dqstring);
            END;|

          spaces:
            IF t=space THEN setstate(spaces); END;|

          colon:
            IF t=equalch THEN setstate(becomes); END;
        ELSE
        END;
      END;
    END;
  END;
  state:=newstate;
END MakeTransition;

PROCEDURE ProcessNextLexeme(VAR line:lines);
VAR
  s:states;
  made:BOOLEAN;

  PROCEDURE Write_Lexeme(VAR s:lines);
  VAR i:indices;
      ch:CHAR;

  BEGIN
    WITH s DO
      FOR i:=start TO (posn-1) DO
         ch:=chr[i];
         IF ch=underscore THEN
            Write('\');Write('_');
         ELSE
            Write(ch);
         END;
      END;
    END;
  END Write_Lexeme;

  PROCEDURE WriteReal(VAR s:lines);
  VAR i:indices;

  BEGIN
    WITH s DO
      Write('$');
      i:=start;
      WHILE chr[i]<>'E' DO Write(chr[i]); INC(i); END;
      WriteString('{\cdot}10^{');
      FOR i:=i+1 TO (posn-1) DO Write(chr[i]); END;
      WriteString('}$');
    END;
  END WriteReal;

  PROCEDURE WritePrime;
  BEGIN
    WriteString("$'$");
  END WritePrime;

VAR
   nt:nonterminals;

BEGIN
  WITH line DO
    Clear(s); s[Next]:=TRUE; start:=posn; made:=TRUE;

    WHILE made DO
      MakeTransition(s,chr[posn],made,nt);
      IF made THEN INC(posn); END;
    END;

    IF nt=realdots THEN DEC(posn,2); nt:=realnum; END;

    IF modeatlevel[commtlev]=texmode THEN
      IF nt=bcomment THEN
        INC(commtlev);
        modeatlevel[commtlev]:=texmode;
        WriteString('\noindent($*$');

      ELSIF nt=ecomment THEN
        DEC(commtlev);
        WriteString('$*$)');
        IF modeatlevel[commtlev]=progmode THEN BeginProgram; END;

      ELSIF nt=stars THEN
        modeatlevel[commtlev]:=progmode;
        BeginProgram;

      ELSE
        Write_Lexeme(line);
      END;

    ELSE
      IF nt=stars  THEN
         modeatlevel[commtlev]:=texmode;
         EndProgram;
      ELSE
        CASE nt OF
          identifier:
            IF reserved(line) THEN
              WriteString('{\bf{}');
              Write_Lexeme(line);
              WriteString('}');

            ELSE
              WriteString('{\it{}');
              Write_Lexeme(line);
              WriteString('\/}');
            END;|

          becomes:
            WriteString('$:=$');|

          lt:
            WriteString('$<$');|

          leq:
            WriteString('$\leq$');|

          gt:
            WriteString('$>$');|

          geq:
            WriteString('$\geq$');|

          neq:
            WriteString('$\neq$');|

          plus:
            WriteString('$+$');|

          minus:
            WriteString('$-$');|

          equal:
            WriteString('$=$');|

          starcom:
            WriteString('$\times$');|

          bcomment:
            EndProgram;
            INC(commtlev);
            modeatlevel[commtlev]:=texmode;
            WriteString('($*$');|

          ecomment:
            EndProgram;
            DEC(commtlev);
            WriteString('$*$)');
            IF modeatlevel[commtlev]=progmode THEN BeginProgram; END;|

          logand:
            WriteString('\&');|

          bset:
            WriteString('$\{$');|

          eset:
            WriteString('$\}$');|

          deref:
            WriteString('$\uparrow$');|

          dots:
            WriteString('$\,.\,.\,$');|

          lognot:
            WriteString('$\neg$');|

          logor:
            WriteString('$|$');|

          sstrg:
            WritePrime;
            WriteString('\Verb');
            Write_Lexeme(line);
            WritePrime;|

          dstrg:
            WritePrime;WritePrime;
            WriteString("\Verb");
            Write_Lexeme(line);
            WritePrime;WritePrime;|

          realexpt:
            WriteReal(line);
          ELSE
            Write_Lexeme(line);
        END;
      END;
    END;
  END;
END ProcessNextLexeme;

PROCEDURE WriteVerb;

BEGIN
   WriteString("\begingroup\catcode`\@=11");WriteLn;
   WriteString("\gdef\@Makeother#1{\catcode`#1=12\relax}%");WriteLn;
   WriteString("\gdef\Verb{\begingroup \catcode``=13 \@Noligs");WriteLn;
   WriteString("\tt \let\do\@Makeother \dospecials \@sVerb}%");WriteLn;
   WriteString("\gdef\@sVerb#1{\def\@tempa ##1#1{\leavevmode\null##1\endgroup}\@tempa}%");WriteLn;
   WriteString("\begingroup\catcode``=13");WriteLn;
   WriteString("\gdef\@Noligs{\let`\@Lquote}\endgroup");WriteLn;
   WriteString("\gdef\@Lquote{\leavevmode{\kern\z@}`}\endgroup");WriteLn;
END WriteVerb;

BEGIN
  commtlev:=minnestinglevel;
  modeatlevel[commtlev]:=progmode;
  WriteString('Give input file:');
  OpenInput('MOD');
  WriteString('Give output file:');
  OpenOutput('TEX');

  WriteVerb;
  WriteString('\def\Filbreak{\vskip0in plus1in ');
  WriteString('\penalty-50 \vskip0in plus-1in\relax}');
  WriteLn;

  WriteString('\Filbreak\medbreak');WriteLn;
  BeginProgram;

  WITH line DO
    REPEAT
      ReadLine(chr);
      Initialise(line);
      IF (chr[posn]=0C) & ~EOF THEN (* blank line *)
        WriteString('\Filbreak%');
        WriteLn;
        ReadLine(chr);
        Initialise(line);
        WHILE (chr[posn]=0C) & ~EOF DO
          WriteString('\vskip\baselineskip%');
          WriteLn;
          ReadLine(chr);
          Initialise(line);
        END;
      END;
      IF ~EOF THEN
        WHILE chr[posn]#0C DO
          ProcessNextLexeme(line);
        END;
        WriteLn;
      END;
    UNTIL EOF;
  END;

  EndProgram;
  WriteString('\Filbreak\medbreak');WriteLn;
  CloseInput; CloseOutput;
END PP.