MODULE M3Front;

IMPORT Wr, Fmt, Thread(** , RTCollector, RTCollectorSRC **);
IMPORT Token, Error, Scanner, Value, Scope, M3String, M3WString, Brand;
IMPORT Module, Type, BuiltinTypes, Host, Tracer, M3Header, InfoModule;
IMPORT BuiltinOps, WordModule, LongModule, M3, Time, Coverage, Marker, TypeFP;
IMPORT Ident, TextExpr, Procedure, SetExpr, TipeDesc, Pathname;
IMPORT ESet, CG, TextWr, Target, ProcBody, RunTyme, M3ID, Variable;
IMPORT Text;
IMPORT AtomicAddrModule, AtomicBoolModule, AtomicCharrModule, AtomicIntModule;
IMPORT AtomicLIntModule, AtomicReffModule, AtomicWCharrModule;

VAR mu         : MUTEX    := NEW (MUTEX);
VAR builtins   : Module.T := NIL;

PROCEDURE ParseImports (READONLY input : SourceFile;
                                 env   : Environment): IDList =
  VAR ids: IDList := NIL;
  BEGIN
    LOCK mu DO
      (* make the arguments globally visible *)
      Host.env      := env;
      Host.source   := input.contents;
      Host.filename := input.name;

      IF (builtins = NIL) THEN Initialize () END;

      Scanner.Push (Host.filename, Host.source, is_main := TRUE);
        ids := M3Header.Parse ();
      Scanner.Pop ();
      RETURN ids;
    END;
  END ParseImports;

PROCEDURE Compile (READONLY input    : SourceFile;
                            env      : Environment;
                   READONLY options  : ARRAY OF TEXT): BOOLEAN =
  VAR ok: BOOLEAN;  start: Time.T;
  BEGIN
    LOCK mu DO
      start := Time.Now ();

      (* make the arguments globally visible *)
      Host.env      := env;
      Host.source   := input.contents;
      Host.filename := input.name;

      IF NOT Host.Initialize (options) THEN RETURN FALSE; END;

      IF NOT Host.stack_walker THEN
        (* command line override... *)
        Target.Has_stack_walker := FALSE;
      END;

      IF (builtins = NIL) THEN Initialize () END;

      Reset ();
      DoCompile ();
      ok := Finalize ();

      IF (Host.report_stats) THEN DumpStats (start, Time.Now ()); END;
    END;
    RETURN ok;
  END Compile;

PROCEDURE Initialize () =
  BEGIN
    (* this list is ordered! *)
    Type.Initialize ();
    TypeFP.Initialize ();

    Scanner.Push ("M3_BUILTIN", NIL, is_main := Host.emitBuiltins);
      builtins := Module.NewDefn ("M3_BUILTIN", TRUE, Scope.Initial);
      BuiltinTypes.Initialize ();
      BuiltinOps.Initialize ();
    Scanner.Pop ();

    Scanner.Push ("Word.i3", NIL, is_main := Host.emitBuiltins);
      WordModule.Initialize ("Word");
    Scanner.Pop ();

    Scanner.Push ("Long.i3", NIL, is_main := Host.emitBuiltins);
      LongModule.Initialize ("Long");
    Scanner.Pop ();

    Scanner.Push ("AtomicAddress.i3", NIL, is_main := Host.emitBuiltins);
      AtomicAddrModule.Initialize ("AtomicAddress");
    Scanner.Pop ();

    Scanner.Push ("AtomicBoolean.i3", NIL, is_main := Host.emitBuiltins);
      AtomicBoolModule.Initialize ("AtomicBoolean");
    Scanner.Pop ();

    Scanner.Push ("AtomicChar.i3", NIL, is_main := Host.emitBuiltins);
      AtomicCharrModule.Initialize ("AtomicChar");
    Scanner.Pop ();

    Scanner.Push ("AtomicInteger.i3", NIL, is_main := Host.emitBuiltins);
      AtomicIntModule.Initialize ("AtomicInteger");
    Scanner.Pop ();

    Scanner.Push ("AtomicLongint.i3", NIL, is_main := Host.emitBuiltins);
      AtomicLIntModule.Initialize ("AtomicLongint");
    Scanner.Pop ();

    Scanner.Push ("AtomicRefany.i3", NIL, is_main := Host.emitBuiltins);
      AtomicReffModule.Initialize ("AtomicRefany");
    Scanner.Pop ();

    Scanner.Push ("AtomicWideChar.i3", NIL, is_main := Host.emitBuiltins);
      AtomicWCharrModule.Initialize ("AtomicWideChar");
    Scanner.Pop ();

    Scanner.Push ("Compiler.i3", NIL, is_main := Host.emitBuiltins);
      InfoModule.Initialize ();
    Scanner.Pop ();
  END Initialize;

PROCEDURE Reset () =
  BEGIN
    (* this list is ordered! *)
    M3String.Reset ();
    M3WString.Reset ();
    Scanner.Reset ();
    Scope.Reset ();
    Coverage.Reset ();
    Error.Reset ();
    Marker.Reset ();
    ESet.Reset ();
    ProcBody.Reset ();
    RunTyme.Reset ();
    TipeDesc.Reset ();
    Tracer.Reset ();
    Type.Reset ();
    TypeFP.Reset ();
    Brand.Reset ();
    Value.Reset ();
    Module.Reset ();
    Ident.Reset ();
    TextExpr.Reset ();
    Procedure.Reset ();
    Variable.Reset ();
    SetExpr.Init ();
    InfoModule.Reset ();
  END Reset;

PROCEDURE DoCompile () =
  VAR m: Module.T;  cs := M3.OuterCheckState;  m_name, filename: M3ID.T;
  BEGIN
    Scanner.Push (Host.filename, Host.source, is_main := TRUE);

    StartPhase ("initializing builtins");
    CheckBuiltins ();

    StartPhase ("parsing");
    m := Module.Parse ();

    (* check that the module name matches the file name *)
    m_name := Module.Name (m);
    filename := M3ID.Add (Pathname.LastBase (Host.filename));
    IF (m_name # filename) THEN
      (* This can trigger due to forward/backward slash confusion,
         so do a looser check here. *)
      VAR
        LastForwardSlash := Text.FindCharR(Host.filename, '/');
        LastBackwardSlash := Text.FindCharR(Host.filename, '\\');
        LastSlash := MAX(LastForwardSlash, LastBackwardSlash);
        Dot : INTEGER;
        Name1 : TEXT;
        Name2 : TEXT;
      BEGIN
        IF LastSlash # -1 THEN
          Dot := Text.FindCharR(Host.filename, '.');
          IF Dot < LastSlash THEN
            Dot := Text.Length(Host.filename);
          END;
          Name1 := Text.Sub(Host.filename, LastSlash + 1, Dot - LastSlash - 1);
          Name2 := M3ID.ToText(m_name);
          IF Text.Equal(Name1, Name2) THEN
            m_name := filename;
          END
        END;
      END;
    END;
    IF (m_name # filename) THEN
      Error.Warn (2, "file name (" & Pathname.Last (Host.filename)
                    & ") doesn't match module name ("
                    & M3ID.ToText (m_name) & ")");
    END;
    IF Failed () THEN RETURN END;

    StartPhase ("type checking");
    Module.TypeCheck (m, TRUE, cs);
    IF Failed () THEN RETURN END;

    StartPhase ("emitting code");
    CG.Init ();
    IF Failed () THEN RETURN END;
    IF (Host.emitBuiltins) THEN
      Module.MakeCurrent (builtins);
      Module.MakeCurrent (WordModule.M);
      Module.MakeCurrent (LongModule.M);
      Module.MakeCurrent (InfoModule.M);
      Module.Compile (builtins);
      Module.Compile (WordModule.M);
      Module.Compile (LongModule.M);
      Module.Compile (InfoModule.M);
    ELSE
      Module.Compile (m);
    END;
    IF Failed () THEN RETURN END;
  END DoCompile;

PROCEDURE CheckBuiltins () =
  VAR cs := M3.OuterCheckState;
  BEGIN
    Value.TypeCheck (builtins, cs);
    Value.TypeCheck (WordModule.M, cs);
    Value.TypeCheck (LongModule.M, cs);
    Value.TypeCheck (InfoModule.M, cs);
  END CheckBuiltins;

PROCEDURE StartPhase (tag: TEXT) =
  BEGIN
    IF (Host.verbose) THEN
      Host.env.report_error (NIL, 0, tag & "...");
    END;
  END StartPhase;

PROCEDURE Failed (): BOOLEAN =
  VAR errs, warns: INTEGER;
  BEGIN
    Error.Count (errs, warns);
    RETURN (errs > 0);
  END Failed;

PROCEDURE DumpStats (start, stop: Time.T) =
  <*FATAL Wr.Failure, Thread.Alerted*>
  VAR
    wr      := TextWr.New ();
    elapsed := MAX (stop - start, 1.0d-6);
    speed   := FLOAT (Scanner.nLines, LONGREAL) / elapsed;
  BEGIN
    Wr.PutText (wr, "  ");
    Wr.PutText (wr, Fmt.Int (Scanner.nLines));
    Wr.PutText (wr, " lines (");
    Wr.PutText (wr, Fmt.Int (Scanner.nPushed));
    Wr.PutText (wr, " files) scanned, ");
    Wr.PutText (wr, Fmt.LongReal (elapsed, Fmt.Style.Fix, 2));
    Wr.PutText (wr, " seconds, ");
    Wr.PutText (wr, Fmt.LongReal (speed, Fmt.Style.Fix, 1));
    Wr.PutText (wr, " lines / second.");
    Host.env.report_error (NIL, 0, TextWr.ToText (wr));
  END DumpStats;

PROCEDURE Finalize (): BOOLEAN =
  <*FATAL Wr.Failure, Thread.Alerted*>
  VAR errs, warns: INTEGER;  wr: TextWr.T;
  BEGIN
    Scanner.Pop ();

    Error.Count (errs, warns);
    IF (errs + warns > 0) THEN
      wr := TextWr.New ();
      IF (errs > 0) THEN
        Wr.PutText (wr, Fmt.Int (errs));
        Wr.PutText (wr, " error");
        IF (errs > 1) THEN Wr.PutText (wr, "s") END;
      END;
      IF (warns > 0) THEN
        IF (errs > 0) THEN Wr.PutText (wr, " and ") END;
        Wr.PutText (wr, Fmt.Int (warns));
        Wr.PutText (wr, " warning");
        IF (warns > 1) THEN Wr.PutText (wr, "s") END;
      END;
      Wr.PutText (wr, " encountered");
      Host.env.report_error (NIL, 0, TextWr.ToText (wr));
    END;

    RETURN (errs <= 0);
  END Finalize;

BEGIN
  M3String.Initialize ();
  M3WString.Initialize ();
  Token.Initialize ();
  Scanner.Initialize ();
  Scope.Initialize ();
END M3Front.