MODULE M3LInitOrder;

(***************************************************************************)
(*                      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, Err, Fmt, SList;
IMPORT M3Context, M3CUnit, M3CId, M3AST_AS;

IMPORT M3AST_AS_F, M3AST_SM_F, M3AST_PL_F;

IMPORT SeqM3AST_AS_Module;


REVEAL 
  Iter = M3Context.Closure BRANDED OBJECT
    showMD: BOOLEAN;
    unitIx, iter_unitIx: INTEGER;
    units: REF ARRAY OF M3AST_AS.Module;
  END;

  T = Iter BRANDED OBJECT END;

TYPE
  Closure = T;

CONST
  DoneST = 2; InProgressST = 1; NotDoneST = 0;

PROCEDURE Set(c: M3Context.T; main: M3AST_AS.Compilation_Unit;
    showMD: BOOLEAN): T RAISES {}=
  VAR
  cl := NEW(Closure, showMD := showMD, callback := FillIn);
  BEGIN
    AllocateArray(cl, c);
    M3Context.Apply(c, cl);
    cl.unitIx := 0;
    AddDepends(cl, main.as_root, NIL);
    RETURN cl;
  END Set;

PROCEDURE AllocateArray(cl: Closure; c: M3Context.T) RAISES {}=
  VAR tcl := NEW(Closure, unitIx := 0, callback := Count);
  BEGIN
    M3Context.Apply(c, tcl);
    IF tcl.unitIx = 0 THEN RETURN END;
    cl.units := NEW(REF ARRAY OF M3AST_AS.Module, tcl.unitIx);
  END AllocateArray;

PROCEDURE Count(cl: Closure; ut: M3CUnit.Type; name: Text.T; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=
  BEGIN
    IF ut = M3CUnit.Type.Module THEN INC(cl.unitIx) END;
  END Count;

PROCEDURE FillIn(cl: Closure; ut: M3CUnit.Type; name: Text.T; 
    cu: M3AST_AS.Compilation_Unit) RAISES {}=
  BEGIN
    IF ut = M3CUnit.Type.Module THEN 
      cl.units[cl.unitIx] := cu.as_root;
      INC(cl.unitIx);
      NARROW(cu.as_root, M3AST_AS.Module).pl_tmp_init_status := NotDoneST;
    END;
  END FillIn;

PROCEDURE AddDepends(cl: Closure; m, dm: M3AST_AS.Module) RAISES {}=
  VAR
    iter: SeqM3AST_AS_Module.Iter;
    tm: M3AST_AS.Module;
  BEGIN
    IF InProgress(m) THEN
      (* cycle *)
      IF cl.showMD THEN
        Err.Print(Fmt.F("mutual dependency between %s and %s",
          M3CId.ToText(dm.as_id.lx_symrep),
          M3CId.ToText(m.as_id.lx_symrep)),
          Err.Severity.Warning);
      END; (* if *)
    ELSE
      SetInProgress(m);
      iter := SeqM3AST_AS_Module.NewIter(m.pl_dependson_s);
      WHILE SeqM3AST_AS_Module.Next(iter, tm) DO
        IF NOT Done(tm) THEN
          AddDepends(cl, tm, m);
        END; (* if *)
      END; (* while *)
      cl.units[cl.unitIx] := m; INC(cl.unitIx);
      SetDone(m);
    END; (* if *)
  END AddDepends;

<*INLINE*> PROCEDURE InProgress(m: M3AST_AS.Module): BOOLEAN RAISES {}=
  BEGIN
    RETURN m.pl_tmp_init_status = InProgressST;
  END InProgress;

<*INLINE*> PROCEDURE SetInProgress(m: M3AST_AS.Module) RAISES {}=
  BEGIN
    m.pl_tmp_init_status := InProgressST;
  END SetInProgress;

<*INLINE*> PROCEDURE SetDone(m: M3AST_AS.Module) RAISES {}=
  BEGIN
    m.pl_tmp_init_status := DoneST;
  END SetDone;

<*INLINE*> PROCEDURE Done(m: M3AST_AS.Module): BOOLEAN RAISES {}=
  BEGIN
    RETURN m.pl_tmp_init_status = DoneST;
  END Done;

PROCEDURE NewIter(t: T): Iter RAISES {}=
  BEGIN
    t.iter_unitIx := 0; RETURN t;
  END NewIter;


PROCEDURE Next(
    iter: Iter; 
    VAR (*out*) cu: M3AST_AS.Compilation_Unit
    ): BOOLEAN RAISES {}=
  BEGIN
    IF iter.iter_unitIx >= iter.unitIx THEN 
      RETURN FALSE
    ELSE
      cu := iter.units[iter.iter_unitIx].sm_comp_unit;
      INC(iter.iter_unitIx);
      RETURN TRUE;
    END;
  END Next;

PROCEDURE Force(c: M3Context.T; order: SList.T): T RAISES {}=
  VAR
    cu: M3AST_AS.Compilation_Unit;
    cl := NEW(Closure);
    elem: SList.TextElem;
  BEGIN
    AllocateArray(cl, c);
    elem := order.head;
    WHILE elem # NIL DO
      IF M3Context.Find(c, elem.text, M3CUnit.Type.Module, cu) THEN
        cl.units[cl.unitIx] := cu.as_root;
        INC(cl.unitIx);
      ELSE
        Err.Print(Fmt.F("module %s in given init order not found", elem.text),
            Err.Severity.Error);
        RETURN NIL
      END; (* if *)
      elem := elem.next;
    END; (* while *)
    RETURN cl;
  END Force;

BEGIN
END M3LInitOrder.