(* Copyright (C) 1991, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

MODULE M3ShowProcTool;

IMPORT Wr, Fmt;
IMPORT ASTWalk;
IMPORT M3Args;
IMPORT M3Context, M3CUnit, M3Conventions;
IMPORT M3AST_AS;
IMPORT M3ShowProc;
IMPORT M3AST_FE_F;

VAR
  tool_g := M3Args.New("m3tk-example", "An example m3tk tool", "6-Apr-92");

PROCEDURE Get(): M3Args.T=
  BEGIN
    RETURN tool_g;
  END Get;

TYPE ContextClosure = M3Context.Closure OBJECT
    wr: Wr.T;
  OVERRIDES callback := VisitUnit;
  END;

PROCEDURE Run(c: M3Context.T; wr: Wr.T)=
  BEGIN
    IF M3Args.Find(tool_g) THEN
      M3Context.Apply(c, NEW(ContextClosure, wr := wr),
                      findStandard := FALSE); (* ignore 'standard' unit *)
    END; (* if *)
  END Run;

PROCEDURE VisitUnit(
    cl: ContextClosure;
    ut: M3CUnit.Type;
    name: TEXT;
    cu: M3AST_AS.Compilation_Unit)
    RAISES {}=

  PROCEDURE ExOrImplicit(): TEXT RAISES {}=
    BEGIN
      IF M3Conventions.PrimarySource IN cu.fe_status THEN
        RETURN "explicitly"
      ELSE
        RETURN "implicitly"
      END;
    END ExOrImplicit;

  BEGIN
    (* if its a generic instantiation, get to actual instantiated tree *)
    cu := M3CUnit.ToGenIns(cu, ut); 
    Wr.PutText(cl.wr, Fmt.F("%s %s - %s compiled\n",
        M3CUnit.TypeName(ut), name, ExOrImplicit()));

    IF M3Conventions.PrimarySource IN cu.fe_status OR
       NOT M3Args.GetFlag(tool_g, Explicit_Arg) THEN
      ASTWalk.VisitNodes(cu, M3ShowProc.NewHandle(cl.wr));
    END;
  END VisitUnit;

BEGIN
  M3Args.RegisterFlag(tool_g, Explicit_Arg,
      "only show procedures in explicitly compiled units");

END M3ShowProcTool.