m3tk/src/astpickle/M3ASTPickle.m3


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

MODULE M3ASTPickle;

IMPORT Rd, Wr, Thread, Pickle;
IMPORT AST, ASTWalk;
IMPORT M3AST_LX, M3AST_AS, M3AST_SC, M3Context, M3CUnit, M3CId, M3CLiteral;
IMPORT SeqM3AST_AS_Used_interface_id, SeqM3AST_SC_Exported_node,
       SeqM3AST_SC_Unit_stub;
IMPORT M3AST_AS_F, M3AST_SM_F, M3AST_TM_F, M3AST_SC_F;

<*FATAL Wr.Failure, Rd.EndOfFile, Rd.Failure, Thread.Alerted, Pickle.Error *>

CONST
  Internal = '0'; External = '1';

TYPE
  Reader = Pickle.Reader OBJECT
    cu: M3AST_AS.Compilation_Unit := NIL;
    context: M3Context.T;
    importProc: ImportedUnitProc;
  END;

  Writer = Pickle.Writer OBJECT
    cu: M3AST_AS.Compilation_Unit;
  END;

PROCEDURE Read(context: M3Context.T; rd: Rd.T; p: ImportedUnitProc;
    VAR cu: M3AST_AS.Compilation_Unit
    ) RAISES {Rd.Failure, Thread.Alerted, Pickle.Error}=
  BEGIN
    cu := NEW(Reader, importProc := p, context := context,
              rd := rd).read();
  END Read;

PROCEDURE Write(cu: M3AST_AS.Compilation_Unit; wr: Wr.T
  ) RAISES {Wr.Failure, Thread.Alerted, Pickle.Error}=
  VAR
    iter := SeqM3AST_AS_Used_interface_id.NewIter(
                NARROW(cu.as_root, M3AST_AS.UNIT_WITH_BODY).sm_import_s);
    used_intf_id: M3AST_AS.Used_interface_id;
  BEGIN
    WHILE SeqM3AST_AS_Used_interface_id.Next(iter, used_intf_id) DO
      BuildExportedNodeTable(
        NARROW(used_intf_id.sm_def, M3AST_AS.UNIT_ID).sm_spec.sm_comp_unit);
    END;
    NEW(Writer, cu := cu, wr := wr).write(cu);
  END Write;

PROCEDURE BuildExportedNodeTable(cu: M3AST_AS.Compilation_Unit)=
  <*FATAL ANY*>
  BEGIN
    IF SeqM3AST_SC_Exported_node.Empty(cu.sc_exported_node_s) THEN
      ASTWalk.VisitNodes(cu, NEW(BuildClosure, cu := cu));
    END;
  END BuildExportedNodeTable;

TYPE BuildClosure = ASTWalk.Closure OBJECT
    cu: M3AST_AS.Compilation_Unit;
  OVERRIDES
    callback := BuildNode
  END;

PROCEDURE BuildNode(cl: BuildClosure; n: AST.NODE;
                    <*UNUSED*> vm: ASTWalk.VisitMode)=
  BEGIN
    TYPECASE n OF
    | M3AST_AS.DEF_ID, M3AST_AS.TYPE_SPEC =>
        SeqM3AST_SC_Exported_node.AddRear(cl.cu.sc_exported_node_s,
            NEW(M3AST_SC.Exported_node, sc_actual_node := n));
    ELSE
    END;
  END BuildNode;

PROCEDURE Special_read_TYPE_SPEC(sp: Pickle.Special; reader: Pickle.Reader;
                                 id: Pickle.RefID): REFANY=
  VAR
    kind := Rd.GetChar(reader.rd);
    type_spec: M3AST_AS.TYPE_SPEC := NIL;
  BEGIN
    IF kind = Internal THEN
      type_spec := Pickle.Special.read(sp, reader, id)
    ELSE
      VAR imported_node: M3AST_SC.IMPORTED_NODE := reader.read();
        a: M3AST_AS.SRC_NODE;
      BEGIN
        IF imported_node # NIL THEN
          IF FindActualFromIMPORTED_NODE(reader, imported_node, a) THEN
            type_spec := a
          END;
        END;
        reader.noteRef(type_spec, id);
      END
    END;
    RETURN type_spec;
  END Special_read_TYPE_SPEC;

PROCEDURE Special_write_TYPE_SPEC(sp: Pickle.Special; r: REFANY;
                                 writer: Pickle.Writer)=

  VAR
    type_spec := NARROW(r, M3AST_AS.TYPE_SPEC);
    ext_unit_id: M3AST_AS.UNIT_ID;
    this_cu := NARROW(writer, Writer).cu;
  BEGIN
    IF ThisUnit(this_cu, type_spec.tmp_unit_id, ext_unit_id) THEN
      Wr.PutChar(writer.wr, Internal);
      Pickle.Special.write(sp, r, writer);
    ELSE
      VAR imported_node: M3AST_SC.IMPORTED_NODE := NIL;
      BEGIN
        IF ext_unit_id # NIL THEN
          imported_node := NewIMPORTED_NODE(this_cu, ext_unit_id, type_spec);
        END;
        Wr.PutChar(writer.wr, External);
        writer.write(imported_node);
      END
    END
  END Special_write_TYPE_SPEC;

PROCEDURE Special_read_DEF_ID(sp: Pickle.Special; reader: Pickle.Reader;
                              id: Pickle.RefID): REFANY=
  VAR
    kind := Rd.GetChar(reader.rd);
    def_id: M3AST_AS.DEF_ID := NIL;
  BEGIN
    IF kind = Internal THEN
      def_id := Pickle.Special.read(sp, reader, id)
    ELSE
      VAR imported_node: M3AST_SC.IMPORTED_NODE := reader.read();
        a: M3AST_AS.SRC_NODE;
      BEGIN
        IF imported_node # NIL THEN
          IF FindActualFromIMPORTED_NODE(reader, imported_node, a) THEN
            def_id := a
          END;
        END;
        reader.noteRef(def_id, id);
      END
    END;
    RETURN def_id;
  END Special_read_DEF_ID;

PROCEDURE Special_write_DEF_ID(sp: Pickle.Special; r: REFANY;
                                 writer: Pickle.Writer)=

  VAR
    def_id := NARROW(r, M3AST_AS.DEF_ID);
    ext_unit_id: M3AST_AS.UNIT_ID;
    this_cu := NARROW(writer, Writer).cu;
  BEGIN
    IF ThisUnit(this_cu, def_id.tmp_unit_id, ext_unit_id) THEN
      Wr.PutChar(writer.wr, Internal);
      Pickle.Special.write(sp, r, writer);
    ELSE
      VAR imported_node: M3AST_SC.IMPORTED_NODE := NIL;
      BEGIN
        IF ext_unit_id # NIL THEN
          imported_node := NewIMPORTED_NODE(this_cu, ext_unit_id, def_id);
        END;
        Wr.PutChar(writer.wr, External);
        writer.write(imported_node);
      END
    END
  END Special_write_DEF_ID;

PROCEDURE NewIMPORTED_NODE(this_cu: M3AST_AS.Compilation_Unit;
                           ext_unit_id: M3AST_AS.UNIT_ID;
                           n: M3AST_AS.SRC_NODE): M3AST_SC.IMPORTED_NODE=
  BEGIN
    WITH ext_cu = ext_unit_id.sm_spec.sm_comp_unit DO
      RETURN NEW(M3AST_SC.IMPORTED_NODE,
          sc_unit_stub := FindOrGenerateUnit_stub(this_cu, ext_cu),
          sc_eoi := FindExportedNodeIndexFor(n, ext_cu));
    END
  END NewIMPORTED_NODE;

PROCEDURE FindActualFromIMPORTED_NODE(
    reader: Reader;
    imported_node: M3AST_SC.IMPORTED_NODE;
    VAR (*out*) actual_node: M3AST_AS.SRC_NODE): BOOLEAN=
  <*FATAL ANY*>
  VAR imp_cu: M3AST_AS.Compilation_Unit;
  BEGIN
    WITH usb = imported_node.sc_unit_stub DO
      IF reader.importProc(
           M3CId.ToText(usb.sc_unit_symrep),
           usb.sc_unit_type,
           usb.sc_unit_uid,
           reader.context,
           imp_cu) THEN
          BuildExportedNodeTable(imp_cu);
          actual_node := FindFromExportedNodeIndex(imp_cu,
                                                   imported_node.sc_eoi);
          RETURN TRUE;
      ELSE
        RETURN FALSE;
      END
    END
  END FindActualFromIMPORTED_NODE;

PROCEDURE ThisUnit(cu: M3AST_AS.Compilation_Unit; unit_id: M3AST_AS.UNIT_ID;
    VAR (*out*) ext_unit_id: M3AST_AS.UNIT_ID): BOOLEAN=
  BEGIN
    IF unit_id = NIL OR unit_id = cu.as_root.as_id THEN RETURN TRUE
    ELSE
      IF ISTYPE(unit_id, M3AST_AS.Module_id) THEN ext_unit_id := NIL
      ELSE ext_unit_id := unit_id
      END;
      RETURN FALSE;
    END
  END ThisUnit;

PROCEDURE FindExportedNodeIndexFor(t: M3AST_AS.SRC_NODE;
    cu: M3AST_AS.Compilation_Unit): INTEGER RAISES{}=
  VAR
    en: M3AST_SC.Exported_node;
    iter := SeqM3AST_SC_Exported_node.NewIter(cu.sc_exported_node_s);
    eoi_uid: INTEGER := 0;
  BEGIN
    WHILE SeqM3AST_SC_Exported_node.Next(iter, en) DO
      IF en.sc_actual_node = t THEN
      	RETURN eoi_uid;
      END; (* if *)
      INC(eoi_uid);
    END; (* while *)
    <*ASSERT FALSE*>
  END FindExportedNodeIndexFor;

PROCEDURE FindFromExportedNodeIndex(
    cu: M3AST_AS.Compilation_Unit;
    this_eoi_uid: INTEGER): M3AST_AS.SRC_NODE=
  VAR
    en: M3AST_SC.Exported_node;
    iter := SeqM3AST_SC_Exported_node.NewIter(cu.sc_exported_node_s);
    eoi_uid: INTEGER := 0;
  BEGIN
    WHILE SeqM3AST_SC_Exported_node.Next(iter, en) DO
      IF eoi_uid = this_eoi_uid THEN
        RETURN en.sc_actual_node;
      END; (* if *)
      INC(eoi_uid);
    END; (* while *)
    <*ASSERT FALSE*>
  END FindFromExportedNodeIndex;

PROCEDURE FindOrGenerateUnit_stub(
    this_cu, ext_cu: M3AST_AS.Compilation_Unit): M3AST_SC.Unit_stub RAISES {}=
  VAR
    iter := SeqM3AST_SC_Unit_stub.NewIter(this_cu.sc_unit_stub_s);
    unit_stub: M3AST_SC.Unit_stub;
  BEGIN
    WHILE SeqM3AST_SC_Unit_stub.Next(iter, unit_stub) DO
      IF ext_cu.as_root.as_id.lx_symrep = unit_stub.sc_unit_symrep THEN
        (* assume same type (interface) *)
        RETURN unit_stub
      END; (* if *)
    END; (* while *)
    unit_stub := NEW(M3AST_SC.Unit_stub,
        sc_unit_symrep := ext_cu.as_root.as_id.lx_symrep,
        sc_unit_uid := ext_cu.fe_uid,
        sc_unit_type := M3CUnit.ToType(ext_cu.as_root));
    SeqM3AST_SC_Unit_stub.AddRear(this_cu.sc_unit_stub_s, unit_stub);
    RETURN unit_stub;
  END FindOrGenerateUnit_stub;

PROCEDURE Special_read_Symbol_rep(<*UNUSED*> sp: Pickle.Special;
                                  reader: Pickle.Reader;
                                  id: Pickle.RefID;): REFANY=
  VAR text: TEXT := reader.read();
  BEGIN
    WITH atom = M3CId.Enter(text) DO
      reader.noteRef(atom, id);
      RETURN atom;
    END
  END Special_read_Symbol_rep;

PROCEDURE Special_write_Symbol_rep(<*UNUSED*> sp: Pickle.Special; r: REFANY;
                                 writer: Pickle.Writer)=
  BEGIN
    writer.write(M3CId.ToText(r));
  END Special_write_Symbol_rep;

PROCEDURE Special_read_Literal_rep(<*UNUSED*> sp: Pickle.Special;
                                   reader: Pickle.Reader;
                                   id: Pickle.RefID): REFANY=
  VAR text: TEXT := reader.read();
  BEGIN
    WITH lit = M3CLiteral.Enter(text) DO
      reader.noteRef(lit, id);
      RETURN lit;
    END
  END Special_read_Literal_rep;

PROCEDURE Special_write_Literal_rep(<*UNUSED*> sp: Pickle.Special; r: REFANY;
                                 writer: Pickle.Writer)=
  BEGIN
    writer.write(M3CLiteral.ToText(r));
  END Special_write_Literal_rep;

BEGIN
  Pickle.RegisterSpecial(
      NEW(Pickle.Special, sc := TYPECODE(M3AST_AS.TYPE_SPEC),
          read := Special_read_TYPE_SPEC,
          write := Special_write_TYPE_SPEC));

  Pickle.RegisterSpecial(
      NEW(Pickle.Special, sc := TYPECODE(M3AST_AS.DEF_ID),
          read := Special_read_DEF_ID,
          write := Special_write_DEF_ID));

  Pickle.RegisterSpecial(
      NEW(Pickle.Special, sc := TYPECODE(M3AST_LX.Symbol_rep),
          read := Special_read_Symbol_rep,
          write := Special_write_Symbol_rep));

  Pickle.RegisterSpecial(
      NEW(Pickle.Special, sc := TYPECODE(M3AST_LX.Literal_rep),
          read := Special_read_Literal_rep,
          write := Special_write_Literal_rep));
END M3ASTPickle.