IMPLEMENTATION MODULE Parser;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/parser.mov   1.9   17 Mar 1991 17:57:48   coleb  $
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)

IMPORT GenLists;
IMPORT ListUtils;
IMPORT M2Strings;
IMPORT PosUtils;
IMPORT StrEdit;
IMPORT SYSTEM;

VAR
  Initialized : BOOLEAN;

CONST
  space = 40C;

VAR
  LineLngth: CARDINAL;

  PROCEDURE GetNxtLstChr(InList: GenLists.GenList; VAR currentLine,
      currentIndex: CARDINAL; VAR TheChar: CHAR);
      (* On entry, currentIndex should identify a character that has
         already been gotten.  On exit, it will identify the character
         just returned; currentLine will identify the line from which
         it was gotten, even if it was the last character on the line. *)
    VAR
      typeCode : CARDINAL;
    BEGIN
      LineLngth := M2Strings.Length(TheLine);
      IF (currentIndex + 1) >= LineLngth THEN
        (* we are at a line end *)
        currentIndex := 0;
        IF currentLine < GenLists.ListLength(InList) THEN
          INC(currentLine);
          GenLists.GetElmt(InList, currentLine, TheLine, typeCode);
            (*read next line*)
          LineLngth := M2Strings.Length(TheLine);
          TheChar := TheLine[currentIndex];
        ELSE
          TheChar := EOF;
            (* we are at file end *)
        END;
      ELSE
        INC(currentIndex);
        TheChar := TheLine[currentIndex];
      END;
    END GetNxtLstChr;


  PROCEDURE SkipComments(VAR inList: GenLists.GenList;
      VAR currentIndex, currentLine: CARDINAL);
    (* Handles nested comments
       currentIndex passed in points to first char of a StartComment
       currentIndex passed out points to the char after EndComment *)
    VAR
      terminator: CHAR;
      tmpLst: GenLists.GenList;
    BEGIN
      GenLists.NewList(tmpLst);
      GetLogicalLst(
          inList,
          StartComment,
          EndComment,
          currentLine,
          currentIndex,
          tmpLst,
          terminator);
      GenLists.DisposeList(tmpLst);
    END SkipComments;


  PROCEDURE ReadComments(VAR InList, OutList: GenLists.GenList;
      NewStartComment, NewEndComment: ARRAY OF CHAR;
      VAR currentIndex, currentLine: CARDINAL);
    (* Extracts comments from InList and appends them to OutList.
       OutList must be initialized before it gets here.  If it has
       at least one element, we append the first line of the comment
       to the last line of OutList.  Handles nested comments;
       currentIndex passed in points to first char of a StartComment;
       currentIndex passed out points to the char after EndComment. *)
    VAR
      StartCmtIndex, EndCmtIndex, TypeCode,
          NestingLevel, CommentLength, NewCommentLength,
          outListLngth: CARDINAL;
      tmpch: CHAR;
    BEGIN
      CommentLength := M2Strings.Length(StartComment);
      NewCommentLength := M2Strings.Length(NewStartComment);
      NestingLevel := 1;

      StartCmtIndex := PosUtils.Positn(StartComment, TheLine, currentIndex);
      IF currentIndex # StartCmtIndex THEN
        (*We weren't on a StartComment.*)
        RETURN;
      END;
      INC(currentIndex, CommentLength);
        (* get currentIndex past the opening comment *)
      outListLngth := GenLists.ListLength(OutList);
      IF outListLngth > 0 THEN
        ListUtils.InsertIntoElmt(OutList, outListLngth,
            SYSTEM.ADR(NewStartComment), NewCommentLength, 65535);
      ELSE
        INC(outListLngth);
        GenLists.ListInsert(NewStartComment, GenLists.StrCode, OutList,
            outListLngth);
      END;
      LOOP
        GetNxtLstChr(InList, currentLine, currentIndex, tmpch);
        IF tmpch = StartComment[0] THEN
          StartCmtIndex := PosUtils.Positn(StartComment, TheLine,
              currentIndex);
          IF currentIndex = StartCmtIndex THEN
            (*We were on a StartComment.*)
            INC(NestingLevel);
          END;
        END;
        IF tmpch = EndComment[0] THEN
          EndCmtIndex := PosUtils.Positn(EndComment, TheLine, currentIndex);
          IF currentIndex = EndCmtIndex THEN
            (*We were on an EndComment.*)
            DEC(NestingLevel);
          END;
          IF NestingLevel = 0 THEN
            INC(currentIndex, CommentLength);
            ListUtils.InsertIntoElmt(OutList, outListLngth,
                SYSTEM.ADR(NewEndComment), NewCommentLength, 65535);
            EXIT;
          END;
        END;
        IF currentIndex > 0 THEN
          ListUtils.InsertIntoElmt(OutList, outListLngth,
              SYSTEM.ADR(tmpch), 1, 65535);
        ELSE
          (* Every time currentIndex goes to zero we start a new
             line in the OutList. *)
          INC(outListLngth);
          GenLists.ListInsert(tmpch, GenLists.StrCode, OutList,
              outListLngth);
        END;
      END;
    END ReadComments;


  PROCEDURE GetLogicalLst(
          inList: GenLists.GenList;
          opener, closer: ARRAY OF CHAR;
      VAR currentLine, currentIndex: CARDINAL;
      VAR outList: GenLists.GenList;
      VAR terminator: CHAR);
      (* On entry, currentIndex should identify a character that has
       * already been gotten (opener).  On exit, it will identify the
       * character just returned (closer or Parser.EOF); currentLine
       * will identify the line from which it was gotten, even if it
       * was the last character on the line.  outList should be
       * initialized on entry, and will be bracketed by opener and
       * closer on exit.
       *)
    VAR
      openerIndex, closerIndex,
          NestingLevel, openerLngth,
          outListLngth: CARDINAL;
      tmpch: CHAR;
    BEGIN
      openerLngth := M2Strings.Length(opener);
      NestingLevel := 1;

      openerIndex := PosUtils.Positn(opener, TheLine, currentIndex);
      IF currentIndex # openerIndex THEN
        (*We weren't on a opener.*)
        RETURN;
      END;
      outListLngth := GenLists.ListLength(outList);
      IF outListLngth > 0 THEN
        ListUtils.InsertIntoElmt(outList, outListLngth,
            SYSTEM.ADR(opener), openerLngth, 65535);
      ELSE
        INC(outListLngth);
        GenLists.ListInsert(opener, GenLists.StrCode, outList,
            outListLngth);
      END;
      LOOP
        GetNxtLstChr(inList, currentLine, currentIndex, tmpch);
        IF tmpch = opener[0] THEN
          openerIndex := PosUtils.Positn(opener, TheLine,
              currentIndex);
          IF currentIndex = openerIndex THEN
            (* We were on an opener.  We don't increment currentIndex
             * past it because, if opener contains more than one
             * character, we want them all copied into outList.
             *)
            INC(NestingLevel);
          END;
        END;
        IF tmpch = closer[0] THEN
          closerIndex := PosUtils.Positn(closer, TheLine, currentIndex);
          IF currentIndex = closerIndex THEN
            (*We were on a closer.*)
            DEC(NestingLevel);
          END;
          IF NestingLevel = 0 THEN
            INC(currentIndex, openerLngth);
            ListUtils.InsertIntoElmt(outList, outListLngth,
                SYSTEM.ADR(closer), openerLngth, 65535);
            EXIT;
          END;
        END;
        IF currentIndex > 0 THEN
          ListUtils.InsertIntoElmt(outList, outListLngth,
              SYSTEM.ADR(tmpch), 1, 65535);
        ELSE
          (* Every time currentIndex goes to zero we start a new
             line in the OutList. *)
          INC(outListLngth);
          GenLists.ListInsert(tmpch, GenLists.StrCode, outList,
              outListLngth);
        END;
      END;
    END GetLogicalLst;


  PROCEDURE GetLogicalStr(
          inList: GenLists.GenList;
          opener, closer: ARRAY OF CHAR;
      VAR currentLine, currentIndex: CARDINAL;
      VAR outStr: ARRAY OF CHAR;
      VAR terminator: CHAR);
    VAR
      tmpLst: GenLists.GenList;
    BEGIN
      GenLists.NewList(tmpLst);
      GetLogicalLst(inList, opener, closer, currentLine, currentIndex,
          tmpLst, terminator);
      ListUtils.ListToString(tmpLst, outStr);
      GenLists.DisposeList(tmpLst);
    END GetLogicalStr;


  PROCEDURE GetNextWord(
          InList: GenLists.GenList;
      VAR CurrentLine, CurrentIndex: CARDINAL;
      VAR NextWord: ARRAY OF CHAR;
      VAR Terminator: CHAR);
    (* To make this start at the beginning of the first line,
       you have to pass 0 to both CurrentLine and CurrentIndex.
       Algorithm is:
        starting from position CurrentIndex in line CurrentLine:
            skip over any blanks
            if at end of line, get a new line
        NextWord := text up to next delimiter
        If delimiter found = StartComment[0], skip any comments
        skip over any blanks
        leave index on next character
        that next character will normally not be a delimiter;
       Weird conditions:
        if next char is a delimiter other than a blank,
          a null nextword will be returned next time
        if get last word on a line, index is left at the end of line
     *)
    VAR
      NextDelim, TypeCode: CARDINAL;
      dumstr: ARRAY [0..191] OF CHAR;
      QuoteChar: CHAR;
      DelimFound : BOOLEAN;

    BEGIN
      StrEdit.SetLength(NextWord, 0);
      LineLngth := M2Strings.Length(TheLine);
      LOOP
        (* We do this first loop just to make sure we have a line to
           work with (we might need to read another one) and to get
           to the next nonblank character (which might be a nonblank
           delimiter. *)
        IF CurrentIndex >= LineLngth THEN
          (* we are at a line end *)
          CurrentIndex := 0;
          IF CurrentLine < GenLists.ListLength(InList) THEN
          (* We aren't at the end of the file. *)
            INC(CurrentLine);
            GenLists.GetElmt(InList, CurrentLine, TheLine, TypeCode);
              (*read next line*)
            LineLngth := M2Strings.Length(TheLine);
          ELSE
            Terminator := EOF;
              (* We are at file end; EOF as Terminator is what
               the caller is supposed to look for to know that the
               end has been reached. *)
            RETURN;
          END;
        ELSIF PosUtils.Present(TheLine[CurrentIndex], whitespace) THEN
          (* skip the character if it's a blank and loop again *)
          INC(CurrentIndex);
        ELSE
          EXIT;
            (* We are on a non-blank, but notice that it might be
             a delimiter. *)
        END;
      END;
      LastIndex := CurrentIndex;
      NextDelim := CurrentIndex;
      IF ((TheLine[NextDelim] = '"') OR (TheLine[NextDelim] = "'"))
          AND PosUtils.Present(TheLine[NextDelim], delimiters) THEN
        (*Looks like beginning of a string literal.  Find end of it.*)
        INC(CurrentIndex);
          (*Prevents copying opening quote into NextWord.*)
        QuoteChar := TheLine[NextDelim];
        REPEAT
            (* skip until come to next delimiter *)
          INC(NextDelim);
        UNTIL (NextDelim >= LineLngth) OR
              (TheLine[NextDelim] = QuoteChar);
      ELSIF ((TheLine[NextDelim] = StartComment[0]) AND
          (TheLine[NextDelim + 1] = StartComment[1])) THEN
        StrEdit.AssignStr(StartComment, NextWord);
        CurrentIndex := NextDelim;
          (* We want to give the user a choice between reading or
             skipping the comment.  We do that by telling them that
             NextWord = StartComment.  If they want to skip it, they
             call SkipComments.  If they want it, they call
             ReadComments. *)
        Terminator := space;
          (* Notice that this is the only case where we exit with
             CurrentIndex pointing to the word itself rather than
             to the first nonblank character following the word. *)
        RETURN;
      ELSE
        DelimFound := FALSE;
        WHILE (NextDelim < LineLngth) AND (NOT DelimFound) DO
          IF (PosUtils.Present(TheLine[NextDelim], delimiters)) THEN
            DelimFound := TRUE;
          ELSE
            (* skip until we come to next delimiter *)
            INC(NextDelim);
          END;
        END;
      END;
      M2Strings.Copy(TheLine, CurrentIndex, NextDelim - CurrentIndex,
          NextWord);
        (* NextWord now contains everything between CurrentIndex and
           NextDelim -- not including the delimiter itself. *)
      CurrentIndex := NextDelim;
        (* Now we need to tell them what the terminating character was.
           If there was whitespace between the end of the word and the
           next item, we'll only tell them that the Terminator was a space
           if the space was required (i.e., if the next item began with
           something other than a delimiter.  Otherwise we'll let them
           assume that everything was jammed together with the least
           possible amount of whitespace. *)
      WHILE (CurrentIndex < LineLngth) AND
         (PosUtils.Present(TheLine[CurrentIndex], whitespace)) DO
        INC(CurrentIndex);
          (* skip over blanks *)
      END;
      IF (CurrentIndex < LineLngth) AND
        (* if on a delimiter *)
         (PosUtils.Present(TheLine[CurrentIndex], delimiters)) THEN
        Terminator := TheLine[CurrentIndex];
          (* return delimiter after word *)
        IF ((TheLine[CurrentIndex] # StartComment[0]) OR
            (TheLine[CurrentIndex + 1] # StartComment[1])) THEN
          (* We have a kludgy convention that for comments, and nothing
             else, we leave CurrentIndex pointing to the first character
             of the comment. *)
          INC(CurrentIndex);
        END;
          (* skip over delimiter before exit *)
      ELSIF CurrentIndex >= LineLngth THEN
        (* if at end of line *)
        Terminator := EOL;
      ELSE
        (* We know we aren't sitting on a delimiter, and we're not at
           the end of the line, so we must have been terminated by a
           blank between words *)
        Terminator := space;
      END;
    END GetNextWord;


  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
(*EntryDiag:
      Diagnostics.Init();
:EntryDiag*)

      GenLists.Init();
      ListUtils.Init();
      M2Strings.Init();
      PosUtils.Init();
      StrEdit.Init();

(*EntryDiag:
      Diagnostics.diagS('Entering Parser', '');
:EntryDiag*)

      StrEdit.AssignStr(' ;:(){}[]-=",.^+*/|#', delimiters);
      StrEdit.Append(delimiters, "'");
      StrEdit.Append(delimiters, EOL);
      StrEdit.Append(delimiters, EOF);
      StrEdit.Append(delimiters, TAB);
      StrEdit.SetLength(TheLine, 0);
      StartComment := '(*';
      EndComment := '*)';
      whitespace[0] := space;
      whitespace[1] := TAB;
      whitespace[2] := EOL;
      whitespace[3] := 12C; (* linefeed *)
      whitespace[4] := 0C;

(*EntryDiag:
      Diagnostics.diagS('Exiting Parser', '');
:EntryDiag*)
    END Init;

BEGIN
  Initialized := FALSE;
  Init();
END Parser.