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

(* File: External.m3                                           *)
(* Last Modified On Tue Apr 21 14:44:54 PDT 1992 By kalsow     *)

MODULE External;

IMPORT Value, ValueRep, Token, String, Scope, Module, Error, Emit;
IMPORT Type, MBuf, Expr, Temp, Variable, Ident, Scanner;
FROM Scanner IMPORT GetToken, Match, Match1, MatchID, cur;

TYPE TK = Token.T;

CONST Stop2 = Token.Set {TK.tAS, TK.tCOMMA, TK.tSEMI};
CONST Stop1 = Token.Set {TK.tIDENT, TK.tSEMI};
CONST Stop0 = Token.Set {TK.tIMPORT, TK.tFROM, TK.tBEGIN, TK.tEND, TK.tEOF}
                           + Token.DeclStart;

REVEAL
  Set = UNTRACED BRANDED "Import.Set" REF RECORD
    exports    : Port;
    imports    : Port;
    importObjs : T;
    last_obj   : T;
  END;

TYPE
  Port = UNTRACED REF RECORD
    next   : Port;
    module : Module.T;
    name   : String.T;
    origin : INTEGER;
    source : T;
    direct : BOOLEAN;
    export : BOOLEAN;
  END;

TYPE
  T = Value.T BRANDED "Import.T" OBJECT
    next : T;
    obj  : Value.T;
    home : Port;
  OVERRIDES
    typeCheck   := Check;
    declare0    := Declare;
    declare1    := Init;
    declare2    := UserInit;
    class       := MyClass;
    fingerprint := FPrinter;
    load        := Load;
    write       := Write;
    toExpr      := ToExpr;
    toType      := ToType;
    typeOf      := TypeOf;
    base        := Base;
  END;

PROCEDURE NewSet (): Set =
  VAR s := NEW (Set);
  BEGIN
    s.exports    := NIL;
    s.imports    := NIL;
    s.importObjs := NIL;
    s.last_obj   := NIL;
    RETURN s;
  END NewSet;

PROCEDURE NoteExport (s: Set;  name: String.T) =
  VAR ex: Module.T;  p: Port;
  BEGIN
    ex := Module.LookUp (name);
    IF (ex = NIL) THEN RETURN END;
    p := Push (s.exports, ex, name);
    p.direct := TRUE;
    p.export := TRUE;
  END NoteExport;

PROCEDURE NoteImport (s: Set;  im: Module.T;  name: String.T) =
  VAR p: Port;
  BEGIN
    IF (im = NIL) THEN RETURN END;
    p := Push (s.imports, im, name);
    p.source := ImportObj (s, im, name, cur.offset, p);
    p.direct := TRUE;
  END NoteImport;

PROCEDURE ParseImports (s: Set;  self: Module.T) =
  BEGIN
    LOOP
      IF    (cur.token = TK.tIMPORT) THEN ParseImport (s);
      ELSIF (cur.token = TK.tFROM)   THEN ParseFromImport (s);
      ELSE  EXIT;
      END;
    END;
    ResolveImports (s, self);
  END ParseImports;

PROCEDURE ParseImport (s: Set) =
  VAR id, alias: String.T;  im: Module.T;
  BEGIN
    Match (TK.tIMPORT, Stop0, Stop2);
    LOOP
      id := MatchID (Stop0, Stop2);
      alias := id;

      IF (cur.token = TK.tAS) THEN
        GetToken (); (* AS *)
        alias := MatchID (Stop0, Stop2);
      END;

      im := Module.LookUp (id);
      NoteImport (s, im, alias);

      IF (cur.token # TK.tCOMMA) THEN EXIT END;
      GetToken (); (* , *)
    END;
    Match1 (TK.tSEMI, Stop0);
  END ParseImport;

PROCEDURE ParseFromImport (s: Set) =
  VAR id: String.T;  j, n: INTEGER;   p: Port;
  BEGIN
    Match (TK.tFROM, Stop0, Stop1);
    id := MatchID (Stop0, Stop1);
    Match (TK.tIMPORT, Stop0, Stop1);
    n := Ident.ParseList (Stop0 + Token.Set {TK.tSEMI});
    Match1 (TK.tSEMI, Stop0);

    p := Push (s.imports, NIL, id);

    j := Ident.top - n;
    FOR i := 0 TO n - 1 DO
      EVAL ImportObj (s, NIL, Ident.stack[j + i], Ident.offset[j + i], p);
    END;
    DEC (Ident.top, n);
  END ParseFromImport;

PROCEDURE Push (VAR list: Port;  m: Module.T;  name: String.T): Port =
  VAR p: Port;
  BEGIN
    (* search for a match *)
    p := list;
    WHILE (p # NIL) DO
      IF (p.name = name) THEN
        IF (m = NIL) OR (p.module = m) THEN (* ok *)
        ELSIF (p.module = NIL) THEN p.module := m;
        ELSE Error.Str (name, "inconsistent imports");
        END;
        RETURN p;
      END;
      p := p.next;
    END;

    (* build a new entry *)
    p := NEW (Port);
    p.next   := list;  list := p;
    p.module := m;
    p.name   := name;
    p.origin := Scanner.offset;
    p.source := NIL;
    p.direct := FALSE;
    p.export := FALSE;
    RETURN p;
  END Push;

PROCEDURE ImportObj (s: Set;  obj: Value.T;  name: String.T;
                      offset: INTEGER;  port: Port): T =
  VAR t := NEW (T);
  BEGIN
    IF (s = NIL) THEN RETURN NIL END;
    ValueRep.Init (t, name);
    t.origin   := offset;
    t.next     := NIL;
    t.obj      := obj;
    t.home     := port;
    t.imported := TRUE;
    t.exported := FALSE;
    IF (port.export) THEN t.exportable := TRUE END;
    IF (s.importObjs = NIL)
      THEN s.importObjs := t;
      ELSE s.last_obj.next := t;
    END;
    s.last_obj := t;
    RETURN t;
  END ImportObj;

PROCEDURE ResolveImports (s: Set;  self: Module.T) =
  VAR
    p     : Port;
    t     : T;
    m     : Module.T;
    v     : Value.T;
    syms  : Scope.T;
    save  : INTEGER;
    objs  : Scope.ValueList;
    nObjs : INTEGER;
  BEGIN
    save := Scanner.offset;

    (* import the exported symbols *)
    p := s.exports;
    WHILE (p # NIL) DO
      m := p.module;
      IF (m # NIL) AND (m # self) THEN
        Scope.ToList (Module.ExportScope (m), objs, nObjs);
        FOR i := 0 TO nObjs - 1 DO
          EVAL ImportObj (s, objs[i], objs[i].name, p.origin, p);
        END;
      END;
      p := p.next;
    END;

    (* resolve the deferred "FROM x IMPORT" modules *)
    p := s.imports;
    WHILE (p # NIL) DO
      IF (p.module = NIL) THEN
        Scanner.offset := p.origin;
        p.module := LookUpInList (p.name, s.imports);
      END;
      p := p.next;
    END;

    (* resolve the deferred "FROM x IMPORT y" imports *)
    t := s.importObjs;
    WHILE (t # NIL) DO
      IF (t.obj = NIL) THEN
        (* this item is from a "FROM x IMPORT" => look up that was deferred *)
        Scanner.offset := t.origin;
        p := t.home;
        IF (p.source # NIL) THEN p.source.used := TRUE END;
        syms := Module.ExportScope (p.module);
        IF (syms # NIL)
          THEN v := Scope.LookUp (syms, t.name, TRUE);
          ELSE v := NIL; (* probably a circular import! *)
        END;
        IF (v = NIL) THEN
          Error.QID (String.QID {module := p.name, item := t.name},
                      "symbol not exported")
        END;
        t.obj := v;
      END;
      t := t.next;
    END;

    Scanner.offset := save;
  END ResolveImports;

PROCEDURE LookUpInList (name: String.T;  local: Port): Module.T =
  BEGIN
    WHILE (local # NIL) DO
      IF (local.name = name) AND (local.module # NIL) THEN
        RETURN local.module;
      END;
      local := local.next;
    END;
    RETURN Module.LookUp (name);
  END LookUpInList;

PROCEDURE LoadImports (s: Set;  self: Module.T) =
  VAR p: Port;  t: T;  m: Module.T;  save: INTEGER;
  BEGIN
    save := Scanner.offset;

    (* load the imported symbols *)
    t := s.importObjs;
    WHILE (t # NIL) DO
      Scanner.offset := t.origin;
      IF (t.obj # NIL) THEN Scope.Insert (t) END;
      t := t.next;
    END;

    (* get the revelations in imported interfaces *)
    p := s.imports;
    WHILE (p # NIL) DO
      IF (p.direct) THEN
        m := p.module;
        Scanner.offset := p.origin;
        IF (m # NIL) AND (m # self) THEN
          Module.ImportRevelations (m, p.source);
        END;
      END;
      p := p.next;
    END;

    (* get the revelations in exported interfaces *)
    p := s.exports;
    WHILE (p # NIL) DO
      IF (p.direct) THEN
        m := p.module;
        Scanner.offset := p.origin;
        IF (m # NIL) AND (m # self) THEN
          Module.ImportRevelations (m, p.source);
        END;
      END;
      p := p.next;
    END;

    Scanner.offset := save;
  END LoadImports;

PROCEDURE IsExportable (v: Value.T): BOOLEAN =
  BEGIN
    TYPECASE v OF
    | NULL => RETURN FALSE;
    | T(t) => RETURN t.home.export;
    ELSE      RETURN FALSE;
    END;
  END IsExportable;

PROCEDURE Redirect (intf, impl: Value.T) =
  VAR t: T := intf;
  BEGIN
    t.obj := impl;
  END Redirect;

PROCEDURE GenLinkInfo (s: Set) =
  BEGIN
    GenInitLinks (s.exports, "A@\n");
    GenInitLinks (s.imports, "B@\n");
  END GenLinkInfo;

PROCEDURE GenInitLinks (p: Port;  fmt: TEXT) =
  VAR x, y: Port;
  BEGIN
    x := p;
    WHILE (x # NIL) DO
      y := p;
      LOOP
        IF (x = y) THEN  Emit.OpS (fmt, x.module.name); EXIT  END;
        IF (x.module = y.module) THEN (* duplicate *) EXIT  END;
        y := y.next;
      END;
      x := x.next;
    END;
  END GenInitLinks;

PROCEDURE GenImports (s: Set) =
  VAR p: Port;
  BEGIN
    Emit.Op ("\n");
    p := s.imports;
    WHILE (p # NIL) DO
      Emit.Op ("\n");
      Scope.Enter (Module.ExportScope (p.module));
      p := p.next;
    END;
    (*******************************
    p := s.exports;
    WHILE (p # NIL) DO
      Emit.Op ("\n");
      Scope.Enter (Module.ExportScope (p.module));
      p := p.next;
    END;
    ***************************)
    Emit.Op ("\n");
  END GenImports;

PROCEDURE InitGlobals (s: Set) =
  VAR x := s.exports;
  BEGIN
    WHILE (x # NIL) DO InitExports (x.module); x := x.next;  END;
  END InitGlobals;

PROCEDURE InitExports (interface: Module.T) =
  VAR
    objs : Scope.ValueList;
    n    : INTEGER;
    o    : Value.T;
  BEGIN
    Scope.ToList (Module.ExportScope (interface), objs, n);
    FOR i := 0 TO n - 1 DO
      o := objs[i];
      IF (o.exported) AND (Value.ClassOf (o) = Value.Class.Var) THEN
        Variable.InitGlobal (o);
      END;
    END;
  END InitExports;

PROCEDURE Check (t: T;  VAR cs: Value.CheckState) =
  BEGIN
    Value.TypeCheck (t.obj, cs);
  END Check;

PROCEDURE Load (t: T): Temp.T =
  BEGIN
    RETURN Value.Load (t.obj);
  END Load;

PROCEDURE Write (t: T) =
  BEGIN
    Value.Write (t.obj);
  END Write;

PROCEDURE MyClass (t: T): Value.Class =
  BEGIN
    RETURN Value.ClassOf (t.obj);
  END MyClass;

PROCEDURE Declare (t: T): BOOLEAN =
  VAR i, e, u: BOOLEAN;  o: Value.T;
  BEGIN
    o := t.obj;
    IF (o # NIL) THEN
      i := o.imported;           e := o.exported;           u := o.used;
      o.imported := t.imported;  o.exported := t.exported;  o.used := t.used;
      Value.Declare0 (t.obj);
      o.imported := i;           o.exported := e;           o.used := u;
    END;
    RETURN FALSE;
  END Declare;

PROCEDURE Init (t: T) =
  BEGIN
    Value.Declare1 (t.obj);
  END Init;

PROCEDURE UserInit  (t: T) =
  BEGIN
    Value.Declare2 (t.obj);
  END UserInit;

PROCEDURE ToExpr (t: T): Expr.T =
  BEGIN
    RETURN Value.ToExpr (t.obj);
  END ToExpr;

PROCEDURE ToType (t: T): Type.T =
  BEGIN
    RETURN Value.ToType (t.obj);
  END ToType;

PROCEDURE TypeOf (t: T): Type.T =
  BEGIN
    RETURN Value.TypeOf (t.obj);
  END TypeOf;

PROCEDURE Base (t: T): Value.T =
  BEGIN
    RETURN t.obj;
  END Base;

PROCEDURE FPrinter (t: T;  map: Type.FPMap;  wr: MBuf.T) =
  BEGIN
    Value.Fingerprint (t.obj, map, wr);
  END FPrinter;

BEGIN
END External.