MODULE M3CGo;

(***************************************************************************)
(*                      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.                                                       *)
(***************************************************************************)

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

IMPORT Text, IO, IOErr, Err, SList;

IMPORT M3AST_AS, ASTWalk, M3Time; 
IMPORT M3CSrcPos, M3CLiteral;

IMPORT M3AST_AS_F, M3AST_SM_F, M3AST_FE_F;

IMPORT SeqM3AST_AS_Used_interface_id, SeqM3AST_AS_IMPORTED,
       SeqM3AST_AS_Import_item;

IMPORT M3CId, M3Context, M3Error, M3CParse, M3CUnit, M3CUnit_priv, 
    M3Conventions;
IMPORT M3CMkStd, M3CSM, M3CSpec, M3CGenIns;


VAR
  current_g: M3AST_AS.Compilation_Unit;
  parser_g: M3CParse.T := NIL;


PROCEDURE CompileInterface(
    context: M3Context.T;
    used_id: M3AST_AS.Used_interface_id;
    caller: M3AST_AS.Compilation_Unit;
    isexport: BOOLEAN;
    p: ImportedUnitProc)
    RAISES {}=
  VAR
    interface: M3AST_AS.Compilation_Unit;
    ens: Text.T;
  BEGIN
    IF used_id.lx_symrep # NIL AND
      p(M3CId.ToText(used_id.lx_symrep), 
        M3CUnit.Type.Interface, context, interface) THEN
      used_id.sm_def := interface.as_root.as_id;
      IF ISTYPE(interface.as_root, M3AST_AS.UNIT_GEN_DEF) THEN
        M3Error.ReportWithId(used_id,
            "illegal import of GENERIC interface \'%s\'", used_id.lx_symrep);
      ELSIF NOT (M3CUnit.State.ImportsResolved IN interface.fe_status) AND
          (caller # interface) THEN
        (* cycle in imports! This can never happen if the 'lx_symrep' of either
         is NIL *)
        M3Error.ReportWithId(used_id,
            "import cycle between interfaces \'%s\' and \'%s\'",
            used_id.lx_symrep, caller.as_root.as_id.lx_symrep);
        M3CUnit.InclState(interface.fe_status, M3CUnit.State.IErrors);
        M3CUnit.InclState(caller.fe_status, M3CUnit.State.IErrors);
      ELSE
        (* if there were IErrors in interface, propagate this fact *)
        IF M3CUnit.State.IErrors IN interface.fe_status THEN
          M3CUnit.InclState(caller.fe_status, M3CUnit.State.IErrors);
        END;
        IF Safe(caller) THEN
          IF NOT Safe(interface) THEN
            IF isexport THEN
              ens := "illegal export of unsafe interface \'%s\'"
            ELSE
              ens := "illegal import of unsafe interface \'%s\'"
            END;
            M3Error.ReportWithId(used_id, ens, used_id.lx_symrep);
          END; (* if *)
        END; (* if *)
        RETURN (* OK *)
      END; (* if *)
    END;
    M3CUnit.InclState(current_g.fe_status, M3CUnit.State.IErrors);
  END CompileInterface;


<*INLINE*> PROCEDURE Safe(cu: M3AST_AS.Compilation_Unit): BOOLEAN RAISES {}=
  BEGIN
    RETURN NARROW(cu.as_root, M3AST_AS.UNIT_NORMAL).as_unsafe = NIL;
  END Safe;

PROCEDURE CompileImports(
    context: M3Context.T;
    cu: M3AST_AS.Compilation_Unit;
    p: ImportedUnitProc)
    RAISES {}=
  VAR
    iterImported: SeqM3AST_AS_IMPORTED.Iter;
    imported: M3AST_AS.IMPORTED;
    iterImport_item: SeqM3AST_AS_Import_item.Iter;
    import_item: M3AST_AS.Import_item;
    local_from_name: M3AST_AS.Import_item;
    from_name: M3AST_AS.Used_interface_id;
    unit_normal := NARROW(cu.as_root, M3AST_AS.UNIT_NORMAL);
  BEGIN
    iterImported := SeqM3AST_AS_IMPORTED.NewIter(unit_normal.as_import_s);
    WHILE SeqM3AST_AS_IMPORTED.Next(iterImported, imported) DO
      TYPECASE imported OF
      | M3AST_AS.Simple_import(si) =>
          iterImport_item := SeqM3AST_AS_Import_item.NewIter(si.as_import_item_s);
          WHILE SeqM3AST_AS_Import_item.Next(
              iterImport_item, import_item) DO
            CompileInterface(context, import_item.as_intf_id, cu, FALSE, p);
          END; (* while *)
      | M3AST_AS.From_import(fi) =>
          local_from_name := CheckForLocalName(unit_normal, fi.as_intf_id);
          IF local_from_name = NIL THEN from_name := fi.as_intf_id
          ELSE from_name := local_from_name.as_intf_id;
          END;
          CompileInterface(context, from_name, cu, FALSE, p);
          (* fix things up; CompileInterface will have set from_name.sm_def
             to the Interface_id of the imported AST. However, if
             local_from_name # NIL, we need to bind to its Interface_AS_id.
          *)
          IF local_from_name # NIL THEN
            fi.as_intf_id.sm_def := local_from_name.as_id;
          END; (* if *)
      END; (* typecase *)
    END;
  END CompileImports;

PROCEDURE CheckForLocalName(
    unit_normal: M3AST_AS.UNIT_NORMAL;
    intf_id: M3AST_AS.Used_interface_id)
    : M3AST_AS.Import_item
    RAISES {}=
  VAR
    iterImported: SeqM3AST_AS_IMPORTED.Iter;
    imported: M3AST_AS.IMPORTED;
    iterImport_item: SeqM3AST_AS_Import_item.Iter;
    import_item: M3AST_AS.Import_item;
  BEGIN
    iterImported := SeqM3AST_AS_IMPORTED.NewIter(unit_normal.as_import_s);
    WHILE SeqM3AST_AS_IMPORTED.Next(iterImported, imported) DO
      TYPECASE imported OF
      | M3AST_AS.Simple_import(si) =>
          iterImport_item := SeqM3AST_AS_Import_item.NewIter(si.as_import_item_s);
          WHILE SeqM3AST_AS_Import_item.Next(
              iterImport_item, import_item) DO
            IF import_item.as_id # NIL AND
               import_item.as_id.lx_symrep = intf_id.lx_symrep THEN
              RETURN import_item;
            END;
          END; (* while *)
      ELSE (* ignore From_import *)
      END; (* typecase *)
    END;
    RETURN NIL;
  END CheckForLocalName;


PROCEDURE CompileExports(
    context: M3Context.T;
    cu: M3AST_AS.Compilation_Unit;
    p: ImportedUnitProc)
    RAISES {}=
  VAR
    moduleId: M3AST_AS.Module_id;
    exports: SeqM3AST_AS_Used_interface_id.T;
    iterExports: SeqM3AST_AS_Used_interface_id.Iter;
    export: M3AST_AS.Used_interface_id;
  BEGIN
    TYPECASE cu.as_root OF
    | M3AST_AS.Module(module) =>
        moduleId := module.as_id;
        exports := module.as_export_s;
        IF SeqM3AST_AS_Used_interface_id.Empty(exports) THEN
          (* implicit export of interface with same name as module *)
          export := M3AST_AS.NewUsed_interface_id();
          export.lx_symrep := moduleId.lx_symrep;
          export.lx_srcpos := moduleId.lx_srcpos;
          SeqM3AST_AS_Used_interface_id.AddRear(module.sm_export_s, export);
          CompileInterface(context, export, cu, TRUE, p);
        ELSE
          iterExports := SeqM3AST_AS_Used_interface_id.NewIter(exports);
          WHILE SeqM3AST_AS_Used_interface_id.Next(iterExports, export) DO
            SeqM3AST_AS_Used_interface_id.AddRear(module.sm_export_s, export);
            CompileInterface(context, export, cu, TRUE, p);
          END; (* while *)
        END; (* if *)
    ELSE
      (* interface - does not have any exports *)
    END; (* typecase *)
  END CompileExports;


PROCEDURE ResolveImportsAndExports(
    context: M3Context.T;
    cu: M3AST_AS.Compilation_Unit;
    p: ImportedUnitProc)
    RAISES {}=
  BEGIN
    IF NOT (M3CUnit.State.ImportsResolved IN cu.fe_status) THEN
      CompileExports(context, cu, p);
      CompileImports(context, cu, p);
      M3CUnit.InclState(cu.fe_status, M3CUnit.State.ImportsResolved);
    END; (* if *)
  END ResolveImportsAndExports;


PROCEDURE ErrorHandler(
    h: M3CParse.ErrorHandler;
    pos: M3CSrcPos.T;
    msg: TEXT)
    RAISES {}=
  BEGIN
    M3CUnit.InclState(current_g.fe_status, M3CUnit.State.PErrors);
    M3Error.ReportAtPos(pos, msg);
  END ErrorHandler;


PROCEDURE Parse(
    input: IO.Stream;
    cu: M3AST_AS.Compilation_Unit;
    headerOnly: BOOLEAN;
    ) RAISES {IO.Error}=
  VAR
    tcu: M3AST_AS.Compilation_Unit;
  BEGIN
    tcu := M3CParse.Compilation(NewParser(input), headerOnly);
    cu.as_root := tcu.as_root;
    cu.lx_comments := tcu.lx_comments;
    cu.lx_pragmas := tcu.lx_pragmas;

    (* Unless we have no tree at all, mark as parsed *)
    IF cu.as_root # NIL THEN
      M3CUnit.InclState(cu.fe_status, M3CUnit.State.Parsed);
    END; (* if *)
  END Parse;

<*INLINE*> PROCEDURE NewParser(input: IO.Stream): M3CParse.T RAISES {}=
  VAR
    errorHandler: M3CParse.ErrorHandler;
  BEGIN
    (* reuse global parser *)
    IF parser_g = NIL THEN
      errorHandler := NEW(M3CParse.ErrorHandler, handle := ErrorHandler);
      parser_g := M3CParse.New(input, M3CId.Table(), M3CLiteral.Table(),
        errorHandler);
    ELSE
      M3CParse.Reset(parser_g, s := input);
    END; (* if *)
    RETURN parser_g;
  END NewParser;

PROCEDURE CompileUnit(
    cu: M3AST_AS.Compilation_Unit;
    context: M3Context.T;
    stream: IO.Stream;
    p: ImportedUnitProc;
    VAR (*inout*) phases: M3CUnit.Status;
    compTime: M3Conventions.CompTime;
    headerOnly := FALSE
    ) RAISES {}=
  VAR
    saveCu: M3AST_AS.Compilation_Unit := current_g;
    startTime: M3Time.T;
    checkedSem := FALSE;
  BEGIN
   current_g := cu;
   TRY
    (* PARSING *)
    IF M3CUnit.State.Parsed IN phases THEN
      IF compTime # NIL THEN startTime := M3Time.Now(); END;
      TRY
        Parse(stream, cu, headerOnly);
      FINALLY
        IOErr.Close(stream, Err.Severity.Warning);
      END;
      IF compTime # NIL THEN compTime.parse := M3Time.Interval(startTime) END;
      phases := phases + (cu.fe_status * M3CUnit.Errors);
    END;

    (* GENERICS *)
    IF ISTYPE(cu.as_root, M3AST_AS.UNIT_GEN_DEF) THEN
      (* nothing more to do for generic definitions *)
      M3CSpec.Set(cu);
      RETURN
    ELSIF ISTYPE(cu.as_root, M3AST_AS.UNIT_GEN_INS) THEN
      (* ok, do the instantiation, and compile it *)
      VAR cu_res := CompileGenericInstantiation(context, cu, p);
      BEGIN
        IF cu_res = NIL THEN
          RETURN
        ELSE
          (* continue with instantiated unit *)
          cu := cu_res;
          current_g := cu;
          M3Error.SetCu(cu);
        END; (* if *)
      END;
    END; (* if *)

    (* IMPORT RESOLUTION *)
    IF M3CUnit.State.ImportsResolved IN phases THEN
      (* precondition *)
      IF M3CUnit.State.Parsed IN cu.fe_status THEN
        IF cu = M3Context.Standard() THEN M3CMkStd.TransForm(cu); END;
        ResolveImportsAndExports(context, cu, p);
        IF M3CUnit.State.IErrors IN cu.fe_status THEN
          M3CUnit.InclState(phases, M3CUnit.State.IErrors);
        END; (* if *)
      ELSE
        M3CUnit.InclState(phases, M3CUnit.State.IErrors);
      END;
    END;

    (* SEMANTIC ANALYSIS *)
    IF M3CUnit.State.SemChecked IN phases THEN
      (* precondition *)
      IF M3CUnit.State.ImportsResolved IN cu.fe_status THEN
        (* IMPORT errors make checking semantics worthless/dangerous *)
        IF M3CUnit.State.IErrors IN cu.fe_status THEN
          M3Error.Report(cu.as_root,
              "semantic analysis suppressed due to import errors");
        ELSE
          IF compTime # NIL THEN startTime := M3Time.Now(); END;
          M3CSM.Check(cu);
          checkedSem := TRUE;
          M3CUnit.InclState(cu.fe_status, M3CUnit.State.SemChecked); 
          IF compTime # NIL THEN 
            compTime.semantic := M3Time.Interval(startTime) 
          END;
        END; (* if *)
      ELSE
        M3CUnit.InclState(phases, M3CUnit.State.SErrors);
      END; (* if *)
    END;
    FINALLY
      LOCK extensions_m DO
        VAR list := NARROW(extensions_g.head, ExtensionElem);
        BEGIN
          WHILE list # NIL DO
            list.e.extend(context, cu, phases);
            list := list.next;
          END;
        END;
      END;
      IF checkedSem THEN
        M3CSM.FinishUp(cu);
      END;
      current_g := saveCu;
    END;
  END CompileUnit;

PROCEDURE CompileGenericInstantiation(
    context: M3Context.T;
    cu_ins: M3AST_AS.Compilation_Unit;
    p: ImportedUnitProc): M3AST_AS.Compilation_Unit
    RAISES {}=
  VAR
    unit_ins := NARROW(cu_ins.as_root, M3AST_AS.UNIT_GEN_INS);
    gen_id := unit_ins.as_gen_id;
    cu_def: M3AST_AS.Compilation_Unit;
    ut: M3CUnit.Type;
  BEGIN
    IF ISTYPE(unit_ins, M3AST_AS.Interface_gen_ins) THEN
      ut := M3CUnit.Type.Interface;
    ELSE
      ut := M3CUnit.Type.Module;
    END; (* if *)
    IF gen_id.lx_symrep # NIL AND
       p(M3CId.ToText(gen_id.lx_symrep), ut, context, cu_def) THEN
      IF ut = M3CUnit.Type.Interface AND
         NOT ISTYPE(cu_def.as_root, M3AST_AS.Interface_gen_def) THEN
        M3Error.ReportWithId(gen_id,
            "\'%s\' is not an GENERIC interface", gen_id.lx_symrep);
      ELSIF ut = M3CUnit.Type.Module AND  
          NOT ISTYPE(cu_def.as_root, M3AST_AS.Module_gen_def) THEN
        M3Error.ReportWithId(gen_id,
            "\'%s\' is not an GENERIC module", gen_id.lx_symrep);
      ELSE
        gen_id.sm_def := cu_def.as_root.as_id;
        unit_ins.sm_ins_comp_unit := M3CGenIns.Set(cu_ins, cu_def);
        WITH cu_res = unit_ins.sm_ins_comp_unit DO
          IF cu_res # NIL THEN
            cu_res.fe_uid := NEW(M3CUnit.Uid);
            cu_res.fe_uid.filename := cu_def.fe_uid.filename &
                "[" & cu_ins.fe_uid.filename & "]";
            cu_res.fe_uid.stamp := cu_ins.fe_uid.stamp;
            IF M3Conventions.PrimarySource IN cu_ins.fe_status THEN
              M3CUnit.InclState(cu_res.fe_status, M3Conventions.PrimarySource);
            END; (* if *)
          END;
        END; (* with *)
        RETURN unit_ins.sm_ins_comp_unit;
      END; (* if *)
    END; (* if *)
    M3CUnit.InclState(cu_ins.fe_status, M3CUnit.State.IErrors);
    RETURN NIL;
  END CompileGenericInstantiation;


PROCEDURE Current(): M3AST_AS.Compilation_Unit RAISES {}=
  BEGIN
    RETURN current_g;
  END Current;

REVEAL
  Extension = Extension_public BRANDED OBJECT END;

TYPE ExtensionElem = SList.Elem OBJECT e: Extension END;

VAR
  extensions_g := SList.T{};
  extensions_m := NEW(MUTEX);

PROCEDURE AddExtension(e: Extension) RAISES {}=
  BEGIN
    LOCK extensions_m DO
      SList.AddRear(extensions_g, NEW(ExtensionElem, e := e));
    END; (* lock *)
  END AddExtension;

PROCEDURE RemoveExtension(e: Extension) RAISES {}=
  VAR head: ExtensionElem := extensions_g.head;
  BEGIN
    LOCK extensions_m DO
      WHILE head # NIL DO
        IF head.e = e THEN
          SList.Remove(extensions_g, head);
          RETURN
        END;
        head := head.next;
      END;
    END; (* lock *)
  END RemoveExtension;


BEGIN
  current_g := NIL;
END M3CGo.