MODULE M3Browser;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT Text, TextExtras, Fmt, Err, IO, HashText;

IMPORT AST, M3AST_AS, M3AST_SM, SeqM3AST_AS_Module;

IMPORT M3AST_AS_F, M3AST_SM_F, M3AST_TM_F, M3AST_FE_F, M3AST_PL_F;

IMPORT SeqM3AST_AS_Used_interface_id;

IMPORT M3Context, M3CUnit, M3CId, M3ASTNext, M3Assert;
IMPORT ASTWalk, M3ASTDisplay, ASTCopy;

TYPE
  UnitTypeSet = M3CUnit.TypeSet;
  UnitType = M3CUnit.Type;

  StreamClosure = M3Context.Closure OBJECT
    s: IO.Stream;
  END;

CONST
  Interfaces = UnitTypeSet{UnitType.Interface};
  Modules = UnitTypeSet{UnitType.Module};
  NoGenerics = UnitTypeSet{UnitType.Interface, UnitType.Interface_gen_ins,
                           UnitType.Module, UnitType.Module_gen_ins};
 
PROCEDURE ShowInterfaces(c: M3Context.T; s: IO.Stream) RAISES {}=
  BEGIN
    ShowGivenUnits(c, s, Interfaces);
  END ShowInterfaces;

PROCEDURE ShowModules(c: M3Context.T; s: IO.Stream) RAISES {}=
  BEGIN
    ShowGivenUnits(c, s, Modules);
  END ShowModules;

PROCEDURE ShowGivenUnits(c: M3Context.T; s: IO.Stream; 
    uts: UnitTypeSet) RAISES {}=
  VAR
    iter: M3Context.Iter;
    name, tn: Text.T;
    cu: M3AST_AS.Compilation_Unit;
    ut: M3CUnit.Type;
    count: INTEGER;
    mark: TEXT;
  BEGIN
    FOR ut := M3CUnit.Type.Interface TO M3CUnit.Type.Module DO
      IF ut IN uts THEN
        IF ut = M3CUnit.Type.Interface THEN tn := "Interfaces"
        ELSE tn := "Modules";
        END;
        IO.PutF(s, "%s:\n", tn);
        count := 0;
	iter := M3Context.NewIter(c, ut, findStandard := FALSE);
        WHILE M3Context.Next(iter, name, cu) DO
          IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
	  IF cu.fe_status * M3CUnit.Errors # M3CUnit.Status{} THEN
	    mark := "*";
          ELSE mark := " ";
          END;
          IO.PutF(s, "%-18s", name & mark); INC(count);
        END;
        IO.Put(s, '\n');IO.Put(s, '\n'); 
      END; (* if *)
      IO.Flush(s);
    END; (* for *)
  END ShowGivenUnits;

PROCEDURE ShowUses(c: M3Context.T; s: IO.Stream; 
    unitName: Text.T; unitType: M3CUnit.Type) RAISES {}=
  VAR
    cu: M3AST_AS.Compilation_Unit;
    seqIter: SeqM3AST_AS_Used_interface_id.Iter;
    used_intf_id: M3AST_AS.Used_interface_id;
    count: INTEGER := 0;
    std_symrep := M3Context.Standard().as_root.as_id.lx_symrep;
  BEGIN
    IF CheckedFind(c, unitName, unitType, cu) THEN
      IO.PutF(s, "Uses relation for %s %s\n", 
          M3CUnit.TypeName(unitType), unitName);
      seqIter := SeqM3AST_AS_Used_interface_id.NewIter(
          NARROW(cu.as_root, M3AST_AS.UNIT_WITH_BODY).sm_import_s);
      WHILE SeqM3AST_AS_Used_interface_id.Next(seqIter, used_intf_id) DO
        IF used_intf_id.lx_symrep # std_symrep THEN
          IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
          INC(count);
          IO.PutF(s, "%-18s",
               M3CId.ToText(used_intf_id.lx_symrep));
          END; (* if *)
      END; (* while *)      
      IO.Put(s, '\n'); IO.Put(s, '\n');
    END;
  END ShowUses;

PROCEDURE ShowDependsOn(c: M3Context.T; s: IO.Stream; 
    moduleName: TEXT) RAISES {}=
  VAR
    cu: M3AST_AS.Compilation_Unit;
    seqIter: SeqM3AST_AS_Module.Iter;
    module: M3AST_AS.Module;
    count: INTEGER := 0;
  BEGIN
    IF CheckedFind(c, moduleName, M3CUnit.Type.Module, cu) THEN
      IO.PutF(s, "Depends-on relation for %s %s\n", 
          M3CUnit.TypeName(M3CUnit.Type.Module), moduleName);
      seqIter := SeqM3AST_AS_Module.NewIter(
        NARROW(cu.as_root, M3AST_AS.Module).pl_dependson_s);
      WHILE SeqM3AST_AS_Module.Next(seqIter, module) DO
        IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
        INC(count);
        IO.PutF(s, "%-18s",
             M3CId.ToText(module.as_id.lx_symrep));
      END; (* while *)      
      IO.Put(s, '\n'); IO.Put(s, '\n');
    END;
  END ShowDependsOn;

PROCEDURE WhoImports(c: M3Context.T; s: IO.Stream; 
    unitName: Text.T) RAISES {}=
  VAR
    cu: M3AST_AS.Compilation_Unit;
    ut: M3CUnit.Type;
  BEGIN
    IF CheckedFind(c, unitName, M3CUnit.Type.Interface, cu) THEN
      WITH cl = NEW(WhoImportsClosure, intf_id := cu.as_root.as_id) DO
        cl.table[M3CUnit.Type.Interface] := HashText.New(16);
        cl.table[M3CUnit.Type.Module] := HashText.New(16);
        M3Context.ApplyToSet(c, cl, NoGenerics);
        ut := M3CUnit.Type.Interface;
        LOOP
          VAR
            tn, importer: TEXT; value: REFANY;
	    count := 0;
            hiter: HashText.Iter := HashText.NewIterator(cl.table[ut]);
	    mark := " ";
          BEGIN
            IF ut = M3CUnit.Type.Interface THEN tn := "Interfaces"
            ELSE tn := "Modules";
            END;
            IO.PutF(s, "%s importing %s:\n", tn, unitName);
            count := 0;
            WHILE HashText.Next(hiter, importer, value) DO
	      IF value # NIL THEN mark := "*" ELSE mark := " " END;
              IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
              INC(count);
              IO.PutF(s, "%-18s", importer & mark);
            END; 
            IO.Put(s, '\n'); IO.Put(s, '\n');
          END;
          IF ut = M3CUnit.Type.Module THEN EXIT END;
          ut := M3CUnit.Type.Module;
        END;
      END;
    END;
  END WhoImports;

TYPE WhoImportsClosure = M3Context.Closure OBJECT
  intf_id: M3AST_AS.UNIT_ID;
  table: ARRAY M3CUnit.Type OF HashText.Table;
  OVERRIDES callback := WhoImportsUnit;
  END;

PROCEDURE WhoImportsUnit(cl: WhoImportsClosure; ut: M3CUnit.Type;
    name: TEXT; cu: M3AST_AS.Compilation_Unit) RAISES {}=
  VAR
    seqIter1: M3ASTNext.IterImportedId;
    seqIter2: SeqM3AST_AS_Used_interface_id.Iter;
    used_intf_id: M3AST_AS.Used_interface_id;

    PROCEDURE CheckEnterTable(direct: BOOLEAN) RAISES {}=
      VAR
        id: HashText.Id;
      BEGIN
        IF used_intf_id.lx_symrep = cl.intf_id.lx_symrep THEN
          IF HashText.Enter(cl.table[ut], 
              M3CId.ToText(cu.as_root.as_id.lx_symrep), id) THEN
	    IF NOT direct THEN
	      HashText.Associate(cl.table[ut], id, NEW(REF BOOLEAN));
            END;
          END;      	
        END;
      END CheckEnterTable;

  BEGIN
    cu := M3CUnit.ToGenIns(cu, ut);
    IF cu = NIL THEN RETURN END;
    (* direct imports *)
    seqIter1 := M3ASTNext.NewIterImportedId(
      NARROW(cu.as_root, M3AST_AS.UNIT_WITH_BODY).as_import_s);
    WHILE M3ASTNext.ImportedId(seqIter1, used_intf_id) DO
       CheckEnterTable(TRUE);
     END;
    (* indirect imports *)
    seqIter2 := SeqM3AST_AS_Used_interface_id.NewIter(
            NARROW(cu.as_root, M3AST_AS.UNIT_WITH_BODY).sm_import_s);
    WHILE SeqM3AST_AS_Used_interface_id.Next(seqIter2, used_intf_id) DO
      CheckEnterTable(FALSE);
    END; (* while *)
  END WhoImportsUnit;


PROCEDURE WhoExports(c: M3Context.T; s: IO.Stream; 
    unitName: Text.T) RAISES {}=
  VAR
    iter: M3Context.Iter;
    seqIter: SeqM3AST_AS_Used_interface_id.Iter;
    cu, tcu: M3AST_AS.Compilation_Unit;
    ut, void: M3CUnit.Type;
    used_intf_id: M3AST_AS.Used_interface_id;
    count: INTEGER := 0;
  BEGIN
    IF CheckedFind(c, unitName, M3CUnit.Type.Interface, cu) THEN
      IO.PutF(s, "Modules exporting %s:\n", unitName);
      ut := M3CUnit.Type.Module;
      LOOP
        iter := M3Context.NewIter(c, ut);
        WHILE M3Context.Next(iter, unitName, tcu) DO
          tcu := M3CUnit.ToGenIns(tcu, void);
          seqIter := SeqM3AST_AS_Used_interface_id.NewIter(
              NARROW(tcu.as_root, M3AST_AS.Module).sm_export_s);
          WHILE SeqM3AST_AS_Used_interface_id.Next(seqIter, used_intf_id) DO
            IF used_intf_id.lx_symrep = cu.as_root.as_id.lx_symrep THEN
              IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
              INC(count);
              IO.PutF(s, "%-18s",
                 M3CId.ToText(tcu.as_root.as_id.lx_symrep));
            END;
          END;
        END;
        IF ut = M3CUnit.Type.Module_gen_ins THEN EXIT END;
        ut := M3CUnit.Type.Module_gen_ins;
      END;
      IO.Put(s, '\n'); IO.Put(s, '\n');
    END;
  END WhoExports;

PROCEDURE WhoDependsOn(c: M3Context.T; s: IO.Stream; 
    unitName: Text.T) RAISES {}=
  VAR
    iter: M3Context.Iter;
    seqIter: SeqM3AST_AS_Module.Iter;
    cu, tcu: M3AST_AS.Compilation_Unit;
    ut, void: M3CUnit.Type;
    module: M3AST_AS.Module;
    count: INTEGER := 0;
    match: BOOLEAN;
  BEGIN
    IF CheckedFind(c, unitName, M3CUnit.Type.Module, cu) THEN
      IO.PutF(s, "Modules depending on %s:\n", unitName);
      iter := M3Context.NewIter(c, M3CUnit.Type.Module);
      ut := M3CUnit.Type.Module;
      LOOP
        WHILE M3Context.Next(iter, unitName, tcu) DO
          tcu := M3CUnit.ToGenIns(tcu, void);
          seqIter := SeqM3AST_AS_Module.NewIter(
              NARROW(tcu.as_root, M3AST_AS.Module).pl_dependson_s);
	  match := FALSE;
          WHILE SeqM3AST_AS_Module.Next(seqIter, module) DO
            IF module.as_id.lx_symrep = cu.as_root.as_id.lx_symrep THEN
	      match := TRUE; EXIT;
            END;
          END;
          IF match THEN
            IF (count MOD 4) = 0 THEN IO.Put(s, '\n'); END;
            INC(count);
            IO.PutF(s, "%-18s",
                 M3CId.ToText(tcu.as_root.as_id.lx_symrep));
          END;
        END;
        IF ut = M3CUnit.Type.Module_gen_ins THEN EXIT END;
        ut := M3CUnit.Type.Module_gen_ins;
      END;
      IO.Put(s, '\n'); IO.Put(s, '\n');
    END;
  END WhoDependsOn;


TYPE FindClosure = ASTWalk.Closure OBJECT
    objName: M3CId.T;
    oots: M3AST_SM.TYPE_SPEC_UNSET := NIL;  (* Opaque or Object *)
  OVERRIDES
    callback := FindOOType;
  END;


PROCEDURE ShowAncestors(c: M3Context.T; s: IO.Stream;
    typeName: Text.T;
    concrete: BOOLEAN; 
    showDetails: BOOLEAN
    ) RAISES {}=
  VAR
    index: CARDINAL;
    unitName, objName: Text.T;
    cu: M3AST_AS.Compilation_Unit;
    indent: INTEGER;
    cl: FindClosure;
  BEGIN
    index := 0; indent := 0;
    IF TextExtras.FindChar(typeName, '.', index) THEN
      unitName := NIL; 
      unitName := TextExtras.Extract(typeName, 0, index);
      objName := NIL; 
      objName := TextExtras.Extract(typeName, index+1, Text.Length(typeName));
      IF M3Context.Find(c, unitName, M3CUnit.Type.Interface, cu) OR
         M3Context.Find(c, unitName, M3CUnit.Type.Module, cu) THEN
        cl := NEW(FindClosure, objName := M3CId.Enter(objName));
        ASTWalk.VisitNodes(cu, cl);
        IF cl.oots # NIL THEN
          IO.PutF(s, "Type Hierarchy for %s\n\n", typeName);
          DisplayAncestors(cl.oots, s, typeName, indent, concrete, 
              showDetails);
        END; (* if *)
      ELSE
        Err.Print(Fmt.F("unit %s not found", unitName), Err.Severity.Error);
      END; (* if *)
    ELSE
      Err.Print("qualified type name required", Err.Severity.Error);
    END; (* if *)
  END ShowAncestors;

PROCEDURE DisplayAncestors(
    oots: M3AST_SM.TYPE_SPEC_UNSET;
    s: IO.Stream;
    typeName: Text.T;
    VAR (*inout*) indent: INTEGER;
    concrete: BOOLEAN; 
    showDetails: BOOLEAN
    ) RAISES {}=
  VAR
    ancestorName: Text.T := NIL;
    i: INTEGER;
    ts: M3AST_SM.TYPE_SPEC_UNSET;
    qual_id: M3AST_AS.Qual_used_id;
    m3type_void: M3AST_AS.M3TYPE_NULL;
  BEGIN
    (* Assert: ISTYPE(oots, M3AST_AS.Opaque_type OR M3AST_AS.Object_type) *) 
    (* First check concrete type *)
    TYPECASE oots OF
    | M3AST_AS.Opaque_type(ots) =>
        IF concrete AND ots.sm_concrete_type_spec # NIL THEN
          oots := ots.sm_concrete_type_spec;
        END;
    ELSE (* drop through *)
    END;

    (* Now pick the ancestor. If "oots" is still opaque, the ancestor
       is the RHS of the opaque type declaration *)
    TYPECASE oots OF
    | M3AST_AS.Object_type(ots) =>
        m3type_void := ots.as_ancestor;
    | M3AST_AS.Opaque_type(ots) =>
          m3type_void := ots.as_type;
    ELSE
      m3type_void := NIL;
    END;  

    IF m3type_void # NIL THEN
      TYPECASE m3type_void OF
      | M3AST_AS.Named_type(nt) =>
        (* Construct qualified name *)
        ts := nt.sm_type_spec;
        qual_id := nt.as_qual_id;
        IF qual_id.as_intf_id # NIL THEN
	  ancestorName := 
              M3CId.ToText(qual_id.as_intf_id.lx_symrep) &
              "." &
              M3CId.ToText(qual_id.as_id.lx_symrep);
        ELSE
          (* convert unqualified name to qualified *)
          ancestorName := M3CId.ToText(qual_id.as_id.lx_symrep);
          IF qual_id.as_id.sm_def # NIL AND
              M3Context.Standard().as_root.as_id #
              qual_id.as_id.sm_def.tmp_unit_id THEN
	    ancestorName := 
                M3CId.ToText(qual_id.as_id.sm_def.tmp_unit_id.lx_symrep) &
                "." &
                ancestorName;
          END; (* if *) 
        END; (* if *)
      ELSE
        ts := m3type_void;
      END;
      IF ISTYPE(ts, M3AST_AS.Object_type) OR
         ISTYPE(ts,  M3AST_AS.Opaque_type) THEN
        DisplayAncestors(ts, s, ancestorName, indent, concrete, 
                         showDetails);
        INC(indent, 2);
      END; (* if *)
    END; (* if *)
    FOR i := 1 TO indent DO
      IO.Put(s, ' ');
    END; (* for *)
    IF typeName = NIL THEN (* inline OBJECT.. supertype *)
      (* copy 'oots', delete ancestors *)
      VAR
        oots_copy: M3AST_AS.Object_type := ASTCopy.Nodes(oots);
      BEGIN
      	oots_copy.as_ancestor := NIL;
        M3ASTDisplay.Nodes(oots_copy, s, indent);
        IO.Put(s, '\n');
      END;
    ELSE
      IO.PutF(s, "%s\n", typeName);
    END;
  END DisplayAncestors;

PROCEDURE FindOOType(cl: FindClosure; 
    an: AST.NODE; vm: ASTWalk.VisitMode) RAISES {ASTWalk.Aborted}=
  VAR
    ts: M3AST_SM.TYPE_SPEC_UNSET;
  BEGIN
    IF ISTYPE(an, M3AST_AS.TYPE_DECL) AND
       (NARROW(an, M3AST_AS.TYPE_DECL).as_id.lx_symrep = cl.objName) THEN
      ts := NARROW(an, M3AST_AS.TYPE_DECL).as_id.sm_type_spec;
      IF ISTYPE(ts, M3AST_AS.Object_type) OR
         ISTYPE(ts,  M3AST_AS.Opaque_type) THEN
        cl.oots := ts;
        ASTWalk.Abort();
      END;
    END; (* if *)
  END FindOOType;

PROCEDURE CheckedFind(c: M3Context.T; unitName: Text.T; 
    ut: M3CUnit.Type;
    VAR (*out*) cu: M3AST_AS.Compilation_Unit): BOOLEAN=
  BEGIN
    IF M3Context.Find(c, unitName, ut, cu) THEN
      cu := M3CUnit.ToGenIns(cu, ut);
      TYPECASE cu.as_root OF
      | NULL =>
          Err.Print("no AST!", Err.Severity.Error);
          RETURN FALSE;
      | M3AST_AS.UNIT_GEN_DEF =>
          Err.Print("command not applicable to a generic definition",
             Err.Severity.Error); 
          RETURN FALSE;
      ELSE
        RETURN TRUE
      END; (* typecase *)
    ELSE
      Err.Print(Fmt.F("%s %s not found", M3CUnit.TypeName(ut), unitName), 
          Err.Severity.Error);
      RETURN FALSE;
    END;
  END CheckedFind;

BEGIN
END M3Browser.