IMPLEMENTATION MODULE YaflError;

IMPORT Comparable;
FROM Streams IMPORT StdOut, OutputStream, StdErr, InputStream;
FROM Conversions IMPORT IntConversions;
FROM List IMPORT List;
FROM YaflModules IMPORT DefinitionModule, ImplementationModule;
FROM YaflCfg IMPORT YaflCfg, CurrentSpot;
IMPORT String;
IMPORT SYSTEM;

  ONCE CLASS LiterateErrorManager;
    VAR
      Lines: ARRAY OF INTEGER;
      CurrentSourceFName,
      CurrentFName: ARRAY OF CHAR;

    CONST
      ChunkSize = 1024;

    REDEFINE METHOD CREATE;
      BEGIN
      BASE;
      Lines.CREATE (ChunkSize);
      END CREATE;

    METHOD ProcessLine (LineNr: INTEGER;
                        Line: ARRAY OF CHAR);
      VAR
        Pos, StartPos, i: INTEGER;
        ToAdd: ARRAY OF INTEGER;
      BEGIN
      Pos := Line.SIZE - 1;
      WHILE (Pos > 1) AND ((Line[Pos] <> '-') OR (Line[Pos-1] <> '-')) DO
        Pos := Pos - 1;
        END;
      IF Pos > 1 THEN
        Pos := Pos + 1;
        IF (Pos < Line.SIZE) AND (Line[Pos] = '<') THEN
          StartPos := Pos + 1;
          WHILE (Pos < Line.SIZE) AND (Line[Pos] <> '>')  DO
            Pos := Pos + 1;
            END;
          IF Pos < Line.SIZE THEN
            IF CurrentFName = VOID THEN
              CurrentFName := Line.SLICE (StartPos, Pos-StartPos);
              END;
            i := IntConversions.StringToInt (Line.SLICE (Pos+1, 
                                             Line.SIZE -Pos)) - 1;
            WHILE LineNr >= Lines.SIZE DO
              ToAdd.CREATE (ChunkSize);
              Lines := Lines + ToAdd;
              END;
            IF i >= 0 THEN
              Lines [LineNr] := i;
              END;
            END;
          END;
        END;
      END ProcessLine;

    METHOD ReadCompilationUnit (SourceFName: ARRAY OF CHAR);
      VAR
        LineNr: INTEGER;
        Input: InputStream;
        Line: ARRAY OF CHAR;
      BEGIN
      FOR i := 0 TO Lines.SIZE - 1 DO
        Lines[i] := -1;
        END;
      CurrentFName := VOID;
      Input.CREATE;
      Input.Open (SourceFName, Input.ReadAccess);
      IF Input.ErrorCode = Input.NoError THEN
        WHILE NOT Input.Eof DO
          LineNr := LineNr + 1;
          Line := Input.ReadLine;
          ProcessLine (LineNr, Line);
          END;
        Input.Close;
        END;
      Lines[0] := 0;
      FOR i := 1 TO Lines.SIZE - 1 DO
        IF Lines[i] <= 0 THEN
          Lines[i] := Lines[i-1] + 1;
          END;
        END;
      END ReadCompilationUnit;
  
    METHOD ErrImage (Err: CompilerError): ARRAY OF CHAR;
      BEGIN
      IF Err.SourceFileName <> VOID THEN
        IF (CurrentSourceFName = VOID) OR
            NOT String.Equals (Err.SourceFileName, CurrentSourceFName) THEN
          CurrentSourceFName := Err.SourceFileName;
          ReadCompilationUnit (CurrentSourceFName);
          END;
        IF Err.LineNr < Lines.SIZE THEN
          RESULT := CurrentFName + ':' + 
                    IntConversions.IntToString (Lines[Err.LineNr], 0) + ':' +
                    Err.Message;
          END;
        END;
      END ErrImage;

  END LiterateErrorManager;
--------------------------------------
  CLASS CompilerError;
    INHERITS Comparable;
    
    VAR           
      IsInDefinition : BOOLEAN;
      TheSourceFileName,
      TheModuleName,
      TheMessage: ARRAY OF CHAR;
      TheLineNr,
      TheColNr: INTEGER;
      TheRef: CompilationUnit;

    REDEFINE METHOD CREATE (LineNr, ColNr: INTEGER;
                            Message: ARRAY OF CHAR;
                            Ref: CompilationUnit);
      BEGIN
      BASE;
      TheLineNr := LineNr;
      TheColNr := ColNr;
      TheMessage := Message;
      SetRef (Ref); 
      END CREATE;
              
    METHOD LineNr: INTEGER;
      BEGIN
      RESULT := TheLineNr;
      END LineNr;

    METHOD ColNr: INTEGER;
      BEGIN
      RESULT := TheColNr;
      END ColNr;

    METHOD Message: ARRAY OF CHAR;
      BEGIN
      RESULT := TheMessage;
      END Message;
                            
    METHOD ModuleName: ARRAY OF CHAR;
      BEGIN          
      RESULT := TheModuleName;
      END ModuleName;         
                      
    METHOD InDefinition: BOOLEAN;
      BEGIN          
      RESULT := IsInDefinition;
      END InDefinition;  
                  
    METHOD KeepIt;
      BEGIN                         
      IF TheRef <> VOID THEN
        TheModuleName := TheRef.Id.Data;
        WHAT TheRef OF
          IN ImplementationModule:
            IsInDefinition := FALSE;
            END;
         ELSE
          IsInDefinition := TRUE;   
          END; -- WHAT         
       ELSE
        IsInDefinition := TRUE;   
        END; -- IF
      END KeepIt;
      
    METHOD SetRef (Ref : CompilationUnit);
      BEGIN      
      TheRef := Ref;
      KeepIt;
      END SetRef;  
      
    METHOD Ref: CompilationUnit;
      BEGIN
      RESULT := TheRef;
      END Ref; 
      
    METHOD Zap;
      BEGIN   
      TheRef := VOID;
      END Zap;    

    METHOD SetSourceFileName (FName: ARRAY OF CHAR);
      BEGIN
      TheSourceFileName := FName;
      END SetSourceFileName;

    METHOD SourceFileName: ARRAY OF CHAR;
      BEGIN
      IF TheRef <> VOID THEN
        RESULT := TheRef.SourceFileName;
        END;
      IF RESULT = VOID THEN
        RESULT := TheSourceFileName;
        END;
      END SourceFileName;
      
    REDEFINE METHOD IsGreater (Other: Comparable): BOOLEAN;
      VAR
        OtherErr: CompilerError;
        Cmp: INTEGER;
      BEGIN         
      WHAT Other OF
        IN CompilerError:
          OtherErr := TAG;
          END;
        END;
      IF (Ref = VOID) THEN
        RESULT := FALSE;
       ELSIF (Ref <> VOID) AND (OtherErr.Ref = VOID) THEN
        RESULT := TRUE;
       ELSE
        Cmp := String.Compare (Ref.WhatAmI + Ref.Id.Data,
                               OtherErr.Ref.WhatAmI + OtherErr.Ref.Id.Data);
        CASE Cmp OF
          String.Smaller:
            RESULT := FALSE;
            END;
          String.Greater:
            RESULT := TRUE;
            END;
          String.Equal:
            IF LineNr < OtherErr.LineNr THEN
              RESULT := FALSE;
             ELSIF LineNr > OtherErr.LineNr THEN
              RESULT := TRUE;
             ELSE 
              RESULT := ColNr > OtherErr.ColNr;
              END;  
            END;
          END;                         
        END; 
      END IsGreater;  

    VAR
      TheImage: ARRAY OF CHAR;

    METHOD BuildImage: ARRAY OF CHAR;
      BEGIN
      IF (Ref <> VOID) AND (Ref.Id <> VOID) THEN
        WHAT Ref OF
          IN DefinitionModule:
            RESULT := "Def:";
            END;
          IN ImplementationModule:
            RESULT := "Imp:";
            END;
          END;
        RESULT := RESULT + Ref.Id.Data;
       ELSIF Ref = VOID THEN
        RESULT := "<void>";
       ELSE
        RESULT := "<no_id>";
        END;
      IF (LineNr > 0) AND (ColNr > 0) THEN
        RESULT := RESULT + ":(" + IntConversions.IntToString (LineNr, 0) +
                       ")(" + IntConversions.IntToString (ColNr, 0) + "):";
	END;
      RESULT := RESULT + Message;
      END BuildImage;

    METHOD Image: ARRAY OF CHAR;
      BEGIN
      IF TheImage = VOID THEN
        IF YaflCfg.LiterateProgrammingErrorProcessing THEN
          TheImage := LiterateErrorManager.ErrImage(THIS);
          END;
        IF TheImage = VOID THEN
          TheImage := BuildImage;
          END;
        END;
      RESULT := TheImage;
      END Image;

  END CompilerError;
----------------------------------------
  CLASS ErrorHandler;
    VAR
      TheErrorList: List(CompilerError);
      CurRef: CompilationUnit;
      TheSourceFileName: ARRAY OF CHAR;

    METHOD Reset;
      BEGIN
      TheErrorList.CREATE;
      END Reset;

    METHOD Sort;
      BEGIN
      TheErrorList.Sort;
      END Sort;
      
    REDEFINE METHOD CREATE;
      BEGIN
      Reset;
      END CREATE;

    METHOD Ref: CompilationUnit;
      BEGIN
      RESULT := CurRef;
      END Ref;

    METHOD SetRef (Ref: CompilationUnit);
      BEGIN
      CurRef := Ref;
      END SetRef;        

    METHOD SetSourceFileName (FName: ARRAY OF CHAR);
      BEGIN
      TheSourceFileName := FName;
      END SetSourceFileName;
      
    METHOD NewError (CErr: CompilerError);
      BEGIN
      TheErrorList.Append (CErr);
      IF YaflCfg.ImmediateErrors THEN
        EmitError (CErr.Image);
        ------------------------------
        -- If the error is emitted immediately,
        -- we already set the process's return code
        -- in case it might be interrupted later.
        ------------------------------
        MainErrorHandler.SetExitCode (MainErrorHandler.ErrorFound);
        END;
      END NewError;                    

    METHOD SetAttachedError (LineNr, ColNr: INTEGER;
                             Message: ARRAY OF CHAR;
                             Based: NonTerminal);
      VAR
        Ref: CompilationUnit;
        CErr: CompilerError;
        Tmp:  NonTerminal;
      BEGIN
      IF Based <> VOID THEN
        Ref := Based.GrandPa;
        DEBUG
          IF Ref = VOID THEN
            StdErr.WriteLine ("Grandpa returned VOID on ("
                              + Based.WhatAmI + ")");
            Tmp := Based;
            WHILE Tmp <> VOID DO
              StdErr.WriteLine ("  -> " + Tmp.WhatAmI);
              Tmp := Tmp.Father;
              END;                 
            END;
          END;
        END;
      IF Ref = VOID THEN
        Ref := CurRef;
        END;
--      ASSERT Ref <> VOID;
      ASSERT TheErrorList <> VOID;
      CErr.CREATE (LineNr, ColNr, Message, Ref);
      CErr.SetSourceFileName (TheSourceFileName);
      NewError (CErr);
      END SetAttachedError;

    METHOD SetError (LineNr, ColNr: INTEGER; Message: ARRAY OF CHAR);
      BEGIN
      SetAttachedError (LineNr, ColNr, Message, VOID);
      END SetError;
      
    METHOD MergeLines: BOOLEAN;
      BEGIN
      RESULT := TRUE;
      END MergeLines;

    METHOD EmitError (Message: ARRAY OF CHAR);
      BEGIN
      StdErr.WriteLine (Message);
      END EmitError;

    METHOD PrintErrorList;
      VAR
        LastLine, LastCol: INTEGER;
        ErrFile: OutputStream;
        PErr: CompilerError;
        a: ARRAY OF CHAR;
      BEGIN
      LastLine := -999;                        
      ----------------------
      -- Apparently, sorting was not such a good idea
      -- after all.
      ----------------------
      -- TheErrorList.Sort;
      ----------------------  
      ErrFile := YaflCfg.ErrorOutputFile;
      FOR i := 0 TO TheErrorList.Size - 1 DO
        PErr := TheErrorList.Get(i);
        IF NOT MergeLines OR
          (PErr.LineNr <> LastLine) OR (PErr.ColNr - LastCol >= 10) THEN
          a := PErr.Image;
          IF NOT YaflCfg.SilentMode THEN
            EmitError (a);
            END;
          IF ErrFile <> VOID THEN
            ErrFile.WriteLine (a);
            END;
          LastLine := PErr.LineNr;
          LastCol := PErr.ColNr;
          END;
        END;
      IF ErrFile <> VOID THEN
        ErrFile.Flush;
        END;
      END PrintErrorList;

    METHOD ErrorCount: INTEGER;
      BEGIN
      RESULT := TheErrorList.Size;
      END ErrorCount;                   
      
    METHOD AttachUnattachedErrors (Ref: CompilationUnit);
      BEGIN    
      FOR TheError IN  TheErrorList | TheError.Ref = VOID DO 
        TheError.SetRef (Ref);
        END; -- FOR
      END AttachUnattachedErrors;  
                
    METHOD Zap;
      BEGIN   
      FOR Err IN TheErrorList DO
        Err.Zap;
        END; -- FOR
      END Zap;    
      
  END ErrorHandler;
---------------------------------------
  ONCE CLASS MainErrorHandler;
    INHERITS ErrorHandler;
    VAR
      LargestCode: INTEGER;

    REDEFINE METHOD SetRef (Ref: CompilationUnit);
      BEGIN
      BASE(Ref);
      WarningHandler.SetRef (Ref);
      END SetRef;
      
    METHOD SetExitCode(Code: INTEGER);
      BEGIN
      ASSERT Code >= 0;
      IF Code > LargestCode THEN
        SYSTEM.SetExitCode (Code);
        LargestCode := Code;
        END;
      END SetExitCode;
      
    REDEFINE METHOD NewError (CErr: CompilerError);
      BEGIN
      BASE (CErr);
      IF CurrentSpot.CurrentCompilationRun <> VOID THEN
        CurrentSpot.CurrentCompilationRun.AppendError (CErr);
        END;
      END NewError;
      
  END MainErrorHandler;
----------------------------------------
  ONCE CLASS WarningHandler;
    INHERITS ErrorHandler;
    
    REDEFINE METHOD MergeLines: BOOLEAN;
      BEGIN
      RESULT := FALSE;
      END MergeLines;
      
    REDEFINE METHOD PrintErrorList;
      BEGIN
      Sort;
      BASE;
      END PrintErrorList;

    REDEFINE METHOD NewError (CErr: CompilerError);
      BEGIN
      BASE (CErr);
      IF CurrentSpot.CurrentCompilationRun <> VOID THEN
        CurrentSpot.CurrentCompilationRun.AppendWarning (CErr);
        END;
      END NewError;
      
  END WarningHandler;

END YaflError;
