m3markup/src/M3MarkUp.m3


 Copyright (C) 1992, Digital Equipment Corporation             
 All rights reserved.                                          
 See the file COPYRIGHT for a full description.                
                                                               
 Last modified on Tue Apr  2 11:30:41 PST 1996 by heydon       
      modified on Tue Mar  7 14:38:20 PST 1995 by kalsow       
                                                               
 Enhanced by Peter Klein (pk@i3.informatik.rwth-aachen.de) to  
 parse procedure signatures and connect procedure declarations 
 in interfaces with their implmentations. -  Mar 7, 1995       

MODULE M3MarkUp;

IMPORT Buf, Text, M3Scanner, M3Token;

CONST
  End_Anchor      = "</A>";
  End_I3          = ".i3\">";
  End_IG          = ".ig\">";
  End_MG          = ".mg\">";
  End_Ref         = "\">";

VAR
  Start_Exporters := "<A HREF=\"/4";
  Start_Interface := "<A HREF=\"/3";
  Start_Exporter  := "<A HREF=\"/S";
  Start_Type      := "<A HREF=\"/L";
  Start_Header    := "<A NAME=\"";

TYPE
  TK = M3Token.T;

TYPE
  State = { Idle, GrabUnit, GrabExports, GrabGeneric, GrabImports,
            GrabFromUnit, SkipFromImports, SkipRename, GrabProc, GrabType
          };

TYPE
  PragmaCleanScanner = M3Scanner.Default OBJECT OVERRIDES
    next := SkipPragmaNext;
  END;

PROCEDURE SetHrefRoot(prefix: TEXT) =
  BEGIN
    Start_Exporters := "<A HREF=\"" & prefix & "/4";
    Start_Interface := "<A HREF=\"" & prefix & "/3";
    Start_Exporter  := "<A HREF=\"" & prefix & "/S";
    Start_Type      := "<A HREF=\"" & prefix & "/L";
    Start_Header    := "<A NAME=\"" & prefix & "";
  END SetHrefRoot;

PROCEDURE Get (buf: Buf.T): Insertion =
  VAR n_exports := 0;
  VAR state := State.GrabUnit;
  VAR is_interface := TRUE;
  VAR is_generic := FALSE;
  VAR id: TEXT;
  VAR id_offs: INTEGER;
  VAR unit := "";
  VAR unit_offs: INTEGER;
  VAR head := NEW (Insertion, next := NIL);
  VAR ins := head;
  VAR lex := NEW (PragmaCleanScanner).initFromBuf (buf, skip_comments := TRUE,
                                                   split_pragmas := FALSE);
  BEGIN
    (* build a list of insertions *)
    LOOP
      CASE lex.token OF
      | TK.Module    => is_interface := FALSE;
      | TK.Interface => is_interface := TRUE;
      | TK.Generic   => is_generic := TRUE;
      | TK.Procedure => state := State.GrabProc;
      | TK.Ident =>
          CASE state OF
          | State.Idle =>
              (* skip it *)
          | State.GrabUnit =>
              GetID (lex, unit, unit_offs);
              IF is_interface AND NOT is_generic THEN
                Add (ins, unit_offs, Start_Exporters);
                Add (ins, unit_offs, unit);
                Add (ins, unit_offs, End_I3);
                Add (ins, unit_offs + lex.length, End_Anchor);
              END;
              IF is_generic
                THEN state := State.SkipFromImports;
                ELSE state := State.GrabImports;
              END;
          | State.GrabExports =>
              GetID (lex, id, id_offs);
              Add (ins, id_offs, Start_Interface);
              Add (ins, id_offs, id);
              Add (ins, id_offs, End_I3);
              Add (ins, id_offs + lex.length, End_Anchor);
              INC (n_exports);
          | State.GrabGeneric =>
              GetID (lex, id, id_offs);
              Add (ins, id_offs, Start_Interface);
              Add (ins, id_offs, id);
              IF is_interface
                THEN Add (ins, id_offs, End_IG);
                ELSE Add (ins, id_offs, End_MG);
              END;
              Add (ins, id_offs + lex.length, End_Anchor);
              state := State.GrabImports;
          | State.GrabImports =>
              GetID (lex, id, id_offs);
              Add (ins, id_offs, Start_Interface);
              Add (ins, id_offs, id);
              Add (ins, id_offs, End_I3);
              Add (ins, id_offs + lex.length, End_Anchor);
          | State.GrabFromUnit =>
              GetID (lex, id, id_offs);
              Add (ins, id_offs, Start_Interface);
              Add (ins, id_offs, id);
              Add (ins, id_offs, End_I3);
              Add (ins, id_offs + lex.length, End_Anchor);
          | State.SkipRename =>
              (* skip this one *)
              state := State.GrabImports;
          | State.SkipFromImports =>
              (* skip this one *)
          | State.GrabProc =>
              IF (is_interface) THEN
                GetID (lex, id, id_offs);
                Add (ins, id_offs, Start_Exporter);
                Add (ins, id_offs, unit & ".i3." & id & "#" & id);
                Add (ins, id_offs, End_Ref);
                Add (ins, id_offs + lex.length, End_Anchor);
              ELSE
                GetID (lex, id, id_offs);
                Add (ins, id_offs, Start_Header);
                Add (ins, id_offs, id);
                Add (ins, id_offs, End_Ref);
                Add (ins, id_offs + lex.length, End_Anchor);
              END;
              lex.next (); (* id *)
              MarkUpSignature (lex, ins, unit, is_interface);
              state := State.Idle;
          | State.GrabType =>
              MarkUpQualTypeIdent (lex, ins, unit);
              lex.next (); (* skip = or <: *)
              MarkUpType (lex, ins, unit, is_interface);
          END;
      | TK.Exports =>
          state := State.GrabExports;
      | TK.Semi =>
          IF (state = State.GrabExports)
            OR (state = State.GrabUnit)
            OR (state = State.GrabFromUnit)
            OR (state = State.SkipRename)
            OR (state = State.SkipFromImports) THEN
            state := State.GrabImports;
          ELSIF (n_exports = 0) AND (state = State.GrabImports)
            AND NOT is_generic AND NOT is_interface THEN
            Add (ins, unit_offs, Start_Interface);
            Add (ins, unit_offs, unit);
            Add (ins, unit_offs, End_I3);
            Add (ins, unit_offs + Text.Length (unit), End_Anchor);
            INC (n_exports);
          ELSIF (state = State.SkipRename) THEN
            state := State.GrabImports;
          END;
      | TK.Equal =>
          IF (state = State.GrabExports) OR (state = State.GrabUnit) THEN
            state := State.GrabGeneric;
          ELSIF (state = State.GrabImports) THEN
            state := State.GrabGeneric;
            IF (n_exports = 0) AND NOT is_generic AND NOT is_interface THEN
              Add (ins, unit_offs, Start_Interface);
              Add (ins, unit_offs, unit);
              Add (ins, unit_offs, End_I3);
              Add (ins, unit_offs + Text.Length (unit), End_Anchor);
              INC (n_exports);
            END;
          END;
      | TK.From =>
          state := State.GrabFromUnit;
      | TK.Import =>
          IF (state = State.GrabFromUnit) THEN
            state := State.SkipFromImports;
          ELSE
            state := State.GrabImports;
          END;
      | TK.As =>
          state := State.SkipRename;
      | TK.Comma =>
          IF (state = State.SkipRename) THEN
            state := State.GrabImports;
          END;
      | TK.Type, TK.Reveal =>
          state := State.GrabType;
      | TK.Const, TK.Exception, TK.Var, TK.Raises,
        TK.Value, TK.End, TK.Readonly, TK.Begin, TK.Case, TK.Exit,
        TK.Eval, TK.For, TK.If, TK.Lock, TK.Loop, TK.Raise, TK.Repeat,
        TK.Until, TK.Return, TK.Typecase, TK.Try, TK.Finally, TK.Except,
        TK.While, TK.Do, TK.With, TK.L_paren =>
          state := State.Idle;
      | TK.EOF, TK.Error =>
          EXIT;
      ELSE
        (* skip it *)
      END;
      lex.next ();
    END;

    RETURN head.next;
  END Get;

PROCEDURE MarkUpType (lex: M3Scanner.T;  VAR ins: Insertion;
                      unit: TEXT;  is_interface: BOOLEAN) =
  (******VAR id: TEXT;  offset: INTEGER;*******)
  BEGIN
    CASE lex.token OF
    | TK.Ident =>
      (*******************
        (* working around an error in M3Token:  ROOT is not
           recognized as a token *)
        GetID (lex, id, offset);
        IF (Text.Equal (id, "ROOT")) THEN
          lex.next (); (* ROOT *)
          IF (lex.token # TK.Semi) AND (lex.token # TK.R_paren)
            AND (lex.token # TK.Assign) AND (lex.token # TK.Equal) THEN
            MarkUpType (lex, ins, unit, is_interface);
          END;
        ELSE
       ****************)
          MarkUpQualTypeIdent (lex, ins, unit);
          IF (lex.token = TK.Object) OR (lex.token = TK.Branded) THEN
            MarkUpType (lex, ins, unit, is_interface);
          END;
      (*************************
        END;
       *************************)
    | TK.Array =>
        WHILE (lex.token # TK.Of) DO
          lex.next (); (* ARRAY or COMMA *)
          IF (lex.token # TK.Of) THEN
            MarkUpType (lex, ins, unit, is_interface);
          END;
        END;
        lex.next (); (* OF *)
        MarkUpType (lex, ins, unit, is_interface);
    | TK.Bits =>
        SkipTo (lex, TK.For);
        lex.next (); (* FOR *)
        MarkUpType (lex, ins, unit, is_interface);
    | TK.L_brace =>
        SkipTo (lex, TK.R_brace);
        lex.next (); (* enum types are boring *)
    | TK.L_bracket =>
        SkipTo (lex, TK.R_bracket);
        lex.next (); (* so are subranges *)
    | TK.Procedure =>
        lex.next (); (* PROCEDURE *)
        MarkUpSignature (lex, ins, unit, is_interface);
    | TK.Record =>
        lex.next (); (* RECORD *)
        MarkUpFields (lex, ins, unit, is_interface);
        lex.next (); (* END *)
    | TK.Object =>
        lex.next (); (* OBJECT *)
        MarkUpFields (lex, ins, unit, is_interface);
        IF (lex.token = TK.Methods) THEN
          lex.next (); (* METHODS *)
          MarkUpMethods (lex, ins, unit, is_interface);
        END;
        IF (lex.token = TK.Overrides) THEN
          lex.next (); (* OVERRIDES *)
          MarkUpOverrides (lex, ins, unit, is_interface);
        END;
        lex.next (); (* END *)
        IF (lex.token = TK.Branded) OR (lex.token = TK.Object) THEN
          MarkUpType (lex, ins, unit, is_interface);
        END;
    | TK.Untraced =>
        lex.next (); (* UNTRACED *)
        MarkUpType (lex, ins, unit, is_interface);
    | TK.Branded =>
        WHILE (lex.token # TK.Ref) AND (lex.token # TK.Object) DO
          lex.next (); (* skip the brand expression *)
        END;
        MarkUpType (lex, ins, unit, is_interface);
    | TK.Ref =>
        lex.next (); (* REF *)
        MarkUpType (lex, ins, unit, is_interface);
    | TK.Set =>
        lex.next (); (* SET *)
        lex.next (); (* OF *)
        MarkUpType (lex, ins, unit, is_interface);
    | TK.L_paren =>
        lex.next (); (* L_paren *)
        MarkUpType (lex, ins, unit, is_interface);
        lex.next (); (* R_paren *)
    ELSE
      (*  <* ASSERT FALSE *>  *)
      (* just ignore in every-day use *)
    END;
  END MarkUpType;

PROCEDURE MarkUpSignature (lex: M3Scanner.T;  VAR ins: Insertion;
                           unit: TEXT;  is_interface: BOOLEAN) =
  BEGIN
    lex.next (); (* L_paren *)
    WHILE (lex.token # TK.R_paren) DO
      CASE lex.token OF
      | TK.Var, TK.Readonly, TK.Value, TK.Semi =>
          (* skip *)
      | TK.Ident =>
          WHILE (lex.token # TK.Colon) AND (lex.token # TK.Assign) DO
            lex.next (); (* formal names and commas *)
          END;
          IF lex.token = TK.Colon THEN
            lex.next ();
            MarkUpType (lex, ins, unit, is_interface);
          END;
          WHILE (lex.token # TK.Semi) AND (lex.token # TK.R_paren) DO
            lex.next ();
          END;
      ELSE
        (*  <* ASSERT FALSE *>  *)
        (* just ignore in every-day use *)
      END;
      IF (lex.token # TK.R_paren) THEN lex.next (); END;
    END;
    lex.next (); (* R_paren *)
    IF (lex.token = TK.Colon) THEN
      lex.next (); (* colon *)
      MarkUpType (lex, ins, unit, is_interface);
    END;
    WHILE (lex.token # TK.Semi) AND (lex.token # TK.Equal)
      AND (lex.token # TK.R_paren) AND (lex.token # TK.Assign)
      AND (lex.token # TK.End) DO
      lex.next ();
    END;
  END MarkUpSignature;

PROCEDURE MarkUpFields (lex: M3Scanner.T;  VAR ins: Insertion;
                        unit: TEXT;  is_interface: BOOLEAN) =
  BEGIN
    WHILE (lex.token # TK.Methods)
      AND (lex.token # TK.Overrides)
      AND (lex.token # TK.End) DO
      WHILE (lex.token # TK.Colon) AND (lex.token # TK.Assign) DO
        lex.next ();
      END;
      IF lex.token = TK.Colon THEN
        lex.next ();
        MarkUpType (lex, ins, unit, is_interface);
      ELSE
        WHILE (lex.token # TK.Semi) AND (lex.token # TK.Methods) AND
          (lex.token # TK.Overrides) AND (lex.token # TK.End) DO
          lex.next ();
        END;
      END;
      IF (lex.token = TK.Semi) THEN lex.next (); END;
    END;
  END MarkUpFields;

PROCEDURE MarkUpMethods (lex: M3Scanner.T;  VAR ins: Insertion;
                         unit: TEXT;  is_interface: BOOLEAN) =
  BEGIN
    WHILE (lex.token # TK.Overrides) AND (lex.token # TK.End) DO
      lex.next ();  (* skip ident *)
      MarkUpSignature (lex, ins, unit, is_interface);
      IF (lex.token = TK.Assign) THEN
        lex.next ();
        MarkUpProc (lex, ins, unit, is_interface);
      END;
      IF (lex.token = TK.Semi) THEN lex.next (); END;
    END;
  END MarkUpMethods;

PROCEDURE MarkUpOverrides (lex: M3Scanner.T;  VAR ins: Insertion;
                          unit: TEXT;  is_interface: BOOLEAN) =
  BEGIN
    WHILE (lex.token # TK.End) DO
      lex.next ();  (* skip ident *)
      lex.next ();  (* skip := *)
      MarkUpProc (lex, ins, unit, is_interface);
      IF (lex.token = TK.Semi) THEN lex.next (); END;
    END;
  END MarkUpOverrides;

PROCEDURE MarkUpQualTypeIdent (lex: M3Scanner.T;  VAR ins: Insertion;
                              currentUnit: TEXT) =
  VAR id: TEXT;
      id_offs, tmp_id_offs: INTEGER;
      anchorPos: INTEGER;
      unit := currentUnit;
  BEGIN
    GetID (lex, id, id_offs);
    anchorPos := id_offs + lex.length;
    lex.next ();
    IF (lex.token = TK.Dot) THEN
      (* qualified identifier *)
      unit := id;
      lex.next ();
      GetID (lex, id, tmp_id_offs);
      anchorPos := tmp_id_offs + lex.length;
      lex.next ();
    END;
    Add (ins, id_offs, Start_Type);
    IF Text.Equal (id, "ADDRESS") OR Text.Equal (id, "BOOLEAN") OR
      Text.Equal (id, "CARDINAL") OR Text.Equal (id, "CHAR") OR
      Text.Equal (id, "EXTENDED") OR Text.Equal (id, "INTEGER") OR
      Text.Equal (id, "LONGINT") OR Text.Equal (id, "LONGREAL") OR
      Text.Equal (id, "MUTEX") OR Text.Equal (id, "NULL") OR
      Text.Equal (id, "REAL") OR Text.Equal (id, "REFANY") OR
      Text.Equal (id, "TEXT") THEN
      Add (ins, id_offs, id);
    ELSE
      Add (ins, id_offs, unit & "." & id);
    END;
    Add (ins, id_offs, End_Ref);
    Add (ins, anchorPos, End_Anchor);
  END MarkUpQualTypeIdent;

PROCEDURE MarkUpProc (lex: M3Scanner.T;  VAR ins: Insertion;
                     currentUnit: TEXT;  is_interface: BOOLEAN) =
  VAR id: TEXT;
      id_offs, tmp_id_offs: INTEGER;
      anchorPos: INTEGER;
      unit := currentUnit;
  BEGIN
    GetID (lex, id, id_offs);
    IF Text.Equal (id, "NIL") THEN lex.next(); RETURN; END;
    anchorPos := id_offs + lex.length;
    lex.next ();
    IF (lex.token = TK.Dot) THEN
      (* qualified identifier *)
      unit := id;
      lex.next ();
      GetID (lex, id, tmp_id_offs);
      anchorPos := tmp_id_offs + lex.length;
      lex.next ();
    END;
    IF (currentUnit # unit) OR is_interface THEN
      Add (ins, id_offs, Start_Exporter);
      Add (ins, id_offs, unit & ".i3." & id & "#" & id);
    ELSE
      Add (ins, id_offs, Start_Interface);
      Add (ins, id_offs, unit & ".m3#" & id);
    END;
    Add (ins, id_offs, End_Ref);
    Add (ins, anchorPos, End_Anchor);
  END MarkUpProc;

PROCEDURE SkipTo (lex: M3Scanner.T;  token: TK) =
  BEGIN
    WHILE (lex.token # token) AND (lex.token # TK.EOF) DO
      lex.next ();
    END;
  END SkipTo;

PROCEDURE GetID (lex: M3Scanner.T;  VAR id: TEXT;  VAR offset: INTEGER) =
  BEGIN
    offset := lex.offset;
    id := Text.FromChars (SUBARRAY (lex.buffer^, lex.offset, lex.length));
  END GetID;

PROCEDURE Add (VAR x: Insertion;  offs: INTEGER;  txt: TEXT) =
  BEGIN
    x.next := NEW (Insertion, next := NIL, offset := offs, insert := txt);
    x := x.next;
  END Add;

PROCEDURE SkipPragmaNext (lex: PragmaCleanScanner) =
  BEGIN
    REPEAT
      M3Scanner.Default.next (lex);
    UNTIL (lex.token # TK.Begin_pragma);
  END SkipPragmaNext;

BEGIN
END M3MarkUp.

interface M3MarkUp is in:


interface Buf is in:


interface M3Scanner is in: