MODULE; 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 M3MarkUp 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; PROCEDUREGet (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; PROCEDUREMarkUpType (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; PROCEDUREMarkUpSignature (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; PROCEDUREMarkUpFields (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; PROCEDUREMarkUpMethods (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; PROCEDUREMarkUpOverrides (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; PROCEDUREMarkUpQualTypeIdent (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; PROCEDUREMarkUpProc (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; PROCEDURESkipTo (lex: M3Scanner.T; token: TK) = BEGIN WHILE (lex.token # token) AND (lex.token # TK.EOF) DO lex.next (); END; END SkipTo; PROCEDUREGetID (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; PROCEDUREAdd (VAR x: Insertion; offs: INTEGER; txt: TEXT) = BEGIN x.next := NEW (Insertion, next := NIL, offset := offs, insert := txt); x := x.next; END Add; PROCEDURESkipPragmaNext (lex: PragmaCleanScanner) = BEGIN REPEAT M3Scanner.Default.next (lex); UNTIL (lex.token # TK.Begin_pragma); END SkipPragmaNext; BEGIN END M3MarkUp.