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

MODULE M3ContextRemove;

IMPORT M3Context, M3CUnit, M3Conventions, M3AST_AS;

IMPORT M3AST_AS_F, M3AST_SM_F, M3AST_FE_F;

IMPORT SeqM3AST_AS_Used_interface_id;

TYPE
  UnitsClosure = M3Context.Closure OBJECT
    unit_id_to_remove: M3AST_AS.UNIT_ID := NIL;
    callerCl: M3Context.Closure;
  OVERRIDES
    callback := RemoveInterfaceUsers;
  END;

  GenUnitsClosure = UnitsClosure OBJECT
  OVERRIDES
    callback := RemoveGenericUsers
  END;

  ErrorClosure =  M3Context.Closure OBJECT
    callerCl: M3Context.Closure;
  OVERRIDES
    callback := RemoveIfErrors;
  END;

PROCEDURE Units(
    context: M3Context.T;
    READONLY units: ARRAY OF TEXT; 
    unitType: M3CUnit.Type;
    cl: M3Context.Closure := NIL;
    ) RAISES {}=
  VAR
    mname: TEXT;
    cu: M3AST_AS.Compilation_Unit;
  BEGIN
    (* Remove any old instances of the requested units from the context. *)
    FOR i := 0 TO NUMBER(units)-1 DO
      mname := M3Conventions.ModuleName(units[i]);
      IF M3Context.Find(context, mname, unitType, cu) THEN
        RemoveUnit(context, cl, unitType, mname, cu);
      END;
    END; (* for *)
  END Units;

PROCEDURE UnitsWithErrors(
    context: M3Context.T;
    cl: M3Context.Closure := NIL
    ) RAISES {}=
  BEGIN
    M3Context.Apply(context,
      NEW(ErrorClosure, callerCl := cl), findStandard := FALSE); 
  END UnitsWithErrors;

PROCEDURE RemoveIfErrors(
    cl: ErrorClosure;
    unitType: M3CUnit.Type; name: TEXT; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=
  BEGIN
    IF (cu.fe_status * M3CUnit.Errors) # M3CUnit.Status{} THEN
      RemoveUnit(cl.context, cl.callerCl, unitType, name, cu);
    END; (* if *)    
  END RemoveIfErrors;

PROCEDURE RemoveUnit(
    context: M3Context.T;
    callerCl: M3Context.Closure;
    unitType: M3CUnit.Type; name: TEXT; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=

  PROCEDURE SafeToUnit(cu: M3AST_AS.Compilation_Unit;
      ut: M3CUnit.Type): M3CUnit.Type RAISES {}=
    BEGIN
      IF cu.as_root = NIL THEN RETURN ut
      ELSE RETURN M3CUnit.ToType(cu.as_root)
      END;
    END SafeToUnit;


  BEGIN
    M3Context.Remove(context, name, unitType);
    IF callerCl # NIL THEN
      callerCl.callback(SafeToUnit(cu, unitType), name, cu);
    END;
    
    IF cu.as_root = NIL THEN RETURN END;

    IF ISTYPE(cu.as_root, M3AST_AS.UNIT_GEN_DEF) THEN
        M3Context.ApplyToSet(context,
            NEW(GenUnitsClosure, unit_id_to_remove := cu.as_root.as_id,
                callerCl := callerCl),
            M3CUnit.TypeSet{M3CUnit.Type.Interface_gen_ins,
                            M3CUnit.Type.Module_gen_ins})
    END;

    IF (unitType = M3CUnit.Type.Interface) THEN
      (* remove everything that uses this interface *)
      TYPECASE cu.as_root OF
      | M3AST_AS.UNIT_GEN_INS(unit_ins) =>
          (* importers are bound to the generated UNIT_NORMAL *)
          cu := unit_ins.sm_ins_comp_unit;
          IF cu = NIL OR cu.as_root = NIL THEN RETURN END;
      ELSE
      END; (* typecase *)

      M3Context.Apply(context,
          NEW(UnitsClosure, unit_id_to_remove := cu.as_root.as_id,
	      callerCl := callerCl),
              findStandard := FALSE);
    END; (* if *)
  END RemoveUnit;

PROCEDURE RemoveInterfaceUsers(
    cl: UnitsClosure;
    unitType: M3CUnit.Type; name: TEXT; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=
  VAR
    iter: SeqM3AST_AS_Used_interface_id.Iter;
    intf_id: M3AST_AS.Used_interface_id;
  BEGIN
    TYPECASE cu.as_root OF
    | M3AST_AS.UNIT_GEN_INS(unit_ins) =>
        cu := unit_ins.sm_ins_comp_unit;
        IF cu = NIL THEN RETURN END;
    ELSE
    END; (* typecase *)
    iter := 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(iter, intf_id) DO
      IF (intf_id.sm_def # NIL) AND
         (NARROW(intf_id.sm_def, M3AST_AS.Interface_id) = cl.unit_id_to_remove) THEN
        M3Context.Remove(cl.context, name, unitType);
	IF cl.callerCl # NIL THEN
	  cl.callerCl.callback(unitType, name, cu);
	END;
      END; (* if *)
    END; (* while *)
  END RemoveInterfaceUsers;

PROCEDURE RemoveGenericUsers(
    cl: GenUnitsClosure;
    unitType: M3CUnit.Type; name: TEXT; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=
  VAR gen_id := NARROW(cu.as_root, M3AST_AS.UNIT_GEN_INS).as_gen_id;
  BEGIN
    (* If this instantation is bound to the generic definition
    to be removed, remove it as well. *)
    IF gen_id.sm_def # NIL AND
       (NARROW(gen_id.sm_def, M3AST_AS.UNIT_ID) = cl.unit_id_to_remove) THEN
      RemoveUnit(cl.context, cl.callerCl, unitType, name, cu);
    END; (* if *)
  END RemoveGenericUsers;

BEGIN

END M3ContextRemove.