MODULE M3CGenIns;

IMPORT PropertyV;
IMPORT AST, M3AST_AS;
IMPORT M3Error, M3CUnit, M3CPragma, M3CPragmaF, ASTCopy, ASTWalk;

IMPORT M3AST_AS_F, M3AST_FE_F, M3AST_TL_F;

IMPORT SeqM3AST_AS_F_Interface_id, SeqM3AST_AS_Used_interface_id,
    SeqM3AST_AS_IMPORTED, SeqM3AST_AS_Import_item;

PROCEDURE Set(
    cu_ins, cu_def: M3AST_AS.Compilation_Unit
    ): M3AST_AS.Compilation_Unit
    RAISES {}=
  VAR
    unit_ins := NARROW(cu_ins.as_root, M3AST_AS.UNIT_GEN_INS);
    unit_def := NARROW(cu_def.as_root, M3AST_AS.UNIT_GEN_DEF);
    n_formals := SeqM3AST_AS_F_Interface_id.Length(unit_def.as_id_s);
    n_actuals := SeqM3AST_AS_Used_interface_id.Length(unit_ins.as_id_s);
    cu_res: M3AST_AS.Compilation_Unit;
  BEGIN
    IF n_formals # n_actuals THEN
      IF n_formals < n_actuals THEN
        M3Error.Report(unit_ins.as_gen_id,
            "too many actual parameters for generic");
      ELSE
        M3Error.Report(unit_ins.as_gen_id,
            "not enough actual parameters for generic");
      END; (* if *)
      M3CUnit.InclState(cu_ins.fe_status, M3CUnit.State.SErrors);
      RETURN NIL;
    END; (* if *)

    (* Prevent instantiation if parse errors in generic definition,
       and propagate error status *)
    IF M3CUnit.State.PErrors IN cu_def.fe_status THEN
      M3CUnit.InclState(cu_ins.fe_status, M3CUnit.State.PErrors);
      RETURN NIL;
    END; (* if *)

    (* A temporary hack to copy the pragma store, if it exists *)
    IF cu_def.lx_pragmas.last # NIL THEN
      <*FATAL ANY*> BEGIN
        cu_res := ASTCopy.ModeNodes(cu_def,
            NEW(CopyClosure, ps := cu_def.lx_pragmas).init(),
            ASTWalk.OnExit);
      END;
      ClonePragmas(cu_def, cu_res);
    ELSE
      cu_res := ASTCopy.Nodes(cu_def);
    END;
    M3CUnit.InclState(cu_res.fe_status, M3CUnit.State.Parsed);
    (* change the root node to be a UNIT_NORMAL *)
    TYPECASE unit_ins OF <*NOWARN*>
    | M3AST_AS.Interface_gen_ins(int_ins) =>
        VAR int_res: M3AST_AS.Interface := NEW(M3AST_AS.Interface).init();
        BEGIN
          int_res.as_unsafe := ASTCopy.Nodes(int_ins.as_unsafe);
          int_res.as_id := ASTCopy.Nodes(int_ins.as_id);
          CopyUNIT_WITH_BODY(cu_res.as_root, int_res);
          cu_res.as_root := int_res;
        END;
    | M3AST_AS.Module_gen_ins(mod_ins) =>
        VAR mod_res: M3AST_AS.Module := NEW(M3AST_AS.Module).init();
        BEGIN
          mod_res.as_unsafe := ASTCopy.Nodes(mod_ins.as_unsafe);
          mod_res.as_id := ASTCopy.Nodes(mod_ins.as_id);
          CopyUNIT_WITH_BODY(cu_res.as_root, mod_res);
          mod_res.as_export_s := mod_ins.as_export_s;
          cu_res.as_root := mod_res;
        END;
    END;

    (* Add the all important IMPORT Ai AS Fi ... nodes *)

    VAR
      iter_formals := SeqM3AST_AS_F_Interface_id.NewIter(unit_def.as_id_s);
      iter_actuals := SeqM3AST_AS_Used_interface_id.NewIter(unit_ins.as_id_s);
      si: M3AST_AS.Simple_import := NEW(M3AST_AS.Simple_import).init();
      fi: M3AST_AS.F_Interface_id;
      ai: M3AST_AS.Used_interface_id;
      im: M3AST_AS.Import_item;
    BEGIN
      WHILE SeqM3AST_AS_F_Interface_id.Next(iter_formals, fi) DO
        EVAL SeqM3AST_AS_Used_interface_id.Next(iter_actuals, ai);
        im := NEW(M3AST_AS.Import_item).init();
        im.as_intf_id := NEW(M3AST_AS.Used_interface_id).init();
        im.as_intf_id.lx_symrep := ai.lx_symrep;
        im.as_id := NEW(M3AST_AS.Interface_AS_id).init();
        im.as_id.lx_symrep := fi.lx_symrep;
        SeqM3AST_AS_Import_item.AddRear(si.as_import_item_s, im);
      END; (* while *)
      SeqM3AST_AS_IMPORTED.AddFront(
        NARROW(cu_res.as_root, M3AST_AS.UNIT_NORMAL).as_import_s,
        si);
    END;
    RETURN cu_res;
  END Set;

PROCEDURE CopyUNIT_WITH_BODY(
    unit_def, unit_res: M3AST_AS.UNIT_WITH_BODY)
    RAISES {}=
  BEGIN
    unit_res.as_import_s := unit_def.as_import_s;
    unit_res.as_block := unit_def.as_block;
  END CopyUNIT_WITH_BODY;

TYPE
  CopyClosure = ASTCopy.Closure OBJECT
    ps: M3CPragma.Store;
  OVERRIDES
    callback := PragmaSupport;
  END;

PROCEDURE PragmaSupport(cl: CopyClosure; def, ins: AST.NODE;
                        <*UNUSED*> vm: ASTWalk.VisitMode)=
  VAR t := cl.ps.first;
  BEGIN
    WHILE t # NIL DO
      IF t.precedingNode = def OR t.followingNode = def OR
         t.precedingStmOrDecl = def THEN
        (* save a forwarding pointer from "def" to "ins" *)
        PropertyV.Put(NARROW(def, M3AST_AS.SRC_NODE).tl_pset, ins);
      END;
      t := t.next;
    END;
  END PragmaSupport;

PROCEDURE ClonePragmas(cu_def, cu_res: M3AST_AS.Compilation_Unit)=
  VAR t_def := cu_def.lx_pragmas.first;
    last: M3CPragma.Iter := NIL;
  BEGIN
    cu_res.lx_pragmas := NEW(M3CPragma.Store);
    WHILE t_def # NIL DO
      WITH t_ins = NEW(M3CPragma.Iter, pos := t_def.pos,
          body := t_def.body,
          precedingNode := Forward(t_def.precedingNode),
          followingNode := Forward(t_def.followingNode),
          precedingStmOrDecl := Forward(t_def.precedingStmOrDecl)) DO
        IF last = NIL THEN
          cu_res.lx_pragmas.first := t_ins;
        ELSE
          last.next := t_ins;
          t_ins.prev := last;
        END;
        last := t_ins;
      END;
      t_def := t_def.next;
    END;
    cu_res.lx_pragmas.last := last;
  END ClonePragmas;

PROCEDURE Forward(n: M3AST_AS.SRC_NODE): M3AST_AS.SRC_NODE=
  BEGIN
    IF n = NIL THEN RETURN NIL ELSE
      RETURN PropertyV.GetSub(n.tl_pset, TYPECODE(M3AST_AS.SRC_NODE));
    END;
  END Forward;

BEGIN
END M3CGenIns.