IMPLEMENTATION MODULE YaflParser;

FROM Conversions IMPORT IntConversions;
FROM Streams     IMPORT StdOut;
FROM YaflError   IMPORT MainErrorHandler, WarningHandler;
FROM YaflCfg     IMPORT YaflCfg;
FROM YaflCreator IMPORT Creators;

  CLASS NonTerminal(gc IN GC);
    INHERITS HashElement;
    
    VAR                     
      UniqueNumber: INTEGER;
      TheLineNr, TheColNr: INTEGER;
      TheFather: NonTerminal;
      TheGrandPa: CompilationUnit;
      TheState: INTEGER;
      
    METHOD State: INTEGER;
      BEGIN
      RESULT := TheState;
      ASSERT RESULT >= InitializedState;
      ASSERT RESULT <= DoneState;
      END State;
      
    METHOD MoveState (NewState: INTEGER);
      BEGIN
      ASSERT NewState >= TheState;
      TheState := NewState;
      END MoveState;
            
    REDEFINE METHOD HashValue: INTEGER;
      BEGIN         
      RESULT := UniqueNumber;
      END HashValue;

    REDEFINE METHOD CREATE (LineNr, ColNr: INTEGER);
      BEGIN
      BASE;
      TheLineNr := LineNr;
      TheColNr := ColNr;
      TheState := InitializedState;
      UniqueNumber := YaflCfg.UniqueNumber;
      END CREATE;

    METHOD LineNr: INTEGER;
      BEGIN
      RESULT := TheLineNr;
      END LineNr;

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

    METHOD Tag;
      BEGIN
      ASSERT IsTagged;
      END Tag;        
      
    METHOD UniqueTag;
      BEGIN
      IF (NOT IsTagged) AND (NOT YaflCfg.Interrupted) THEN
        TheState := StartedTaggingState;
        ASSERT IsTagged;
        Tag;  
        ASSERT TheState < EndedTaggingState;
        TheState := EndedTaggingState;
        END; -- IF
      END UniqueTag;
      
    METHOD IsTagged: BOOLEAN;
      BEGIN        
      RESULT := (State >= TaggedState);
      END IsTagged;
      
    METHOD Parse(Lkh: LookAhead);
      BEGIN
      ASSERT NOT IsParsed;
      TheState := ParsedState;
      ASSERT IsParsed;
      END Parse;

    METHOD IsParsed: BOOLEAN;
      BEGIN
      RESULT := (State >= ParsedState);
      END IsParsed;
        
    METHOD Error(Message: ARRAY OF CHAR);
      BEGIN     
      IF GrandPa = VOID THEN   
        IF MainErrorHandler.Ref <> VOID THEN
          MainErrorHandler.Ref.MarkError;
          END; -- IF
       ELSE
        GrandPa.MarkError;
        END;
      MainErrorHandler.SetAttachedError (LineNr, ColNr, Message, THIS);
      END Error;

    METHOD Warning(Message: ARRAY OF CHAR);
      BEGIN
      WarningHandler.SetAttachedError (LineNr, ColNr, 
                                       "Warning: " + Message, THIS);
      END Warning;

    METHOD SetFather(TheFather: NonTerminal);
      BEGIN
      THIS.TheFather := TheFather;
      END SetFather;
      
    ------------------------------------------
    -- The GetAncestor methods follows the Father
    -- chain until the current ancestor is compatible
    -- with r's reference class.
    ------------------------------------------
    METHOD GetAncestor (r: Ref);
      VAR
        p: NonTerminal;
      BEGIN
      ASSERT r <> VOID;
      p := Father;
      r.Set(VOID);
      WHILE (p <> VOID) DO
        WHAT p OF
          IN r.Element:
            r.Set(TAG);
            p := VOID;
            END;
         ELSE
          p := p.Father;
          END;
        END;
      END GetAncestor;

    METHOD GrandPa: CompilationUnit;
      VAR              
        r: ONCE Ref(CompilationUnit);
      BEGIN
      IF TheGrandPa = VOID THEN 
        IF (r = VOID) THEN
          r.CREATE(VOID);
          END;
        GetAncestor (r);
        TheGrandPa := r.Get;        
        r.Set(VOID);
        END;
      RESULT := TheGrandPa;
      END GrandPa;

    METHOD SetSon(Son: NonTerminal);
      BEGIN
      IF Son <> VOID THEN
        Son.SetFather(THIS);
        END;
      END SetSon;

    METHOD Father: NonTerminal;
      BEGIN
      IF TheFather = THIS THEN
        RESULT := VOID;
       ELSE
        RESULT := TheFather;
        END;
      END Father;

    METHOD CheckType;
      BEGIN
      DEBUG
        StdOut.WriteString ("Non redefined CheckType method: " + WhatAmI);
        StdOut.WriteLn;
        -- ASSERT FALSE;
        END;
      END CheckType;
      
    METHOD IsTypeChecked: BOOLEAN;
      BEGIN        
      RESULT := State >= StartedTypeCheckingState;
      END IsTypeChecked;
        
    METHOD UniqueCheckType;
      BEGIN                            
      ASSERT IsTagged;
      IF NOT IsTypeChecked THEN
        TheState := StartedTypeCheckingState;
        ASSERT IsTypeChecked;
        CheckType;  
        ASSERT TheState < EndedTypeCheckingState;
        TheState := EndedTypeCheckingState;
        END;
      END UniqueCheckType;
      
    VAR
      TheGC: gc;
        
    METHOD Gc: gc;
      BEGIN 
      IF TheGC = VOID THEN
        WHAT Creators.CodeGenerator.CreateGC(THIS) OF
          IN gc:
            TheGC := TAG;
            END;
          END;
        END; 
      RESULT := TheGC;
      END Gc;

     METHOD GcIsAttached : BOOLEAN;
       BEGIN
       RESULT := (TheGC <> VOID);
       END GcIsAttached;
   
     METHOD ClearGc;
       BEGIN
       TheGC := VOID; 
       --IF YaflCfg.VerboseLevel > 1 THEN
       --  StdOut.WriteLine("Pruning Code Generators from " + WhatAmI );
       --  END;
       END ClearGc;
        
    -----------------------------------------
    -- The GrabSubNodes method creates a walker
    -- initialized on THIS, and appends all its
    -- elements which are compatible with TheList
    -----------------------------------------
    METHOD GrabSubNodes (TheList: AbstractList);
      VAR
        Walk: Walker;
        p: NonTerminal;
      BEGIN   
      ASSERT TheList <> VOID;
      Walk.CREATE (THIS);
      p := Walk.Next;
      WHILE p <> VOID DO
        WHAT p OF
          IN TheList.Element:
            TheList.Append (TAG);
            END;
         ELSE
          -- Don't abort
          END;
        p := Walk.Next;
        END;
      END GrabSubNodes;

    -----------------------------------------------------------------
    -- Generic hierachy handling methods
    -----------------------------------------------------------------
    METHOD DisplayAncestors;
      VAR
        p: NonTerminal;
        CUnit: CompilationUnit;
      BEGIN
      p := THIS;
      WHILE p <> VOID DO
        StdOut.WriteString ('(' + IntConversions.IntToString (p.LineNr, 0) + 
                           ')(' + IntConversions.IntToString (p.ColNr, 0) + 
                           ')[' + p.WhatAmI + ']');
        CUnit := p.GrandPa;
        IF CUnit <> VOID THEN
          StdOut.WriteLine (" <" + CUnit.WhatAmI + "> " + CUnit.Id.Data);
         ELSE
          StdOut.WriteLn;
          END;        
        p := p.Father;
        END;
      END DisplayAncestors;  
      
  END NonTerminal;
----------------------------------------
  CLASS Walker;
    CONST
      VecSize = 128;
    VAR
      SubTrees: ARRAY OF ARRAY OF NonTerminal;
      Position: ARRAY OF INTEGER;
      Level: INTEGER;

    METHOD PackSubTree (Vec: ARRAY OF NonTerminal): ARRAY OF NonTerminal;
      VAR
         Used: INTEGER;
      BEGIN
      IF Vec <> VOID THEN
        FOR i := 0 TO Vec.SIZE -1 DO
          IF Vec[i] <> VOID THEN
            Used := Used + 1;
            END;
          END;
        IF Used = Vec.SIZE THEN
          RESULT := Vec;
         ELSIF Used > 0 THEN
          RESULT.CREATE (Used);
          Used := 0;
          FOR i := 0 TO Vec.SIZE -1 DO
            IF Vec[i] <> VOID THEN
              RESULT[Used] := Vec[i];
              Used := Used + 1;
              END;
            END;
          END;
        END;
      END PackSubTree;

    REDEFINE METHOD CREATE(From: NonTerminal);
      VAR
        p: ARRAY OF NonTerminal;
      BEGIN
      ASSERT From <> VOID;
      SubTrees.CREATE(VecSize);
      Position.CREATE(VecSize);
      p.CREATE (1);
      p[0] := From;
      SubTrees [0] := p;
      END CREATE;

    METHOD Depth: INTEGER;
      BEGIN
      RESULT := Level;
      END Depth;

    METHOD SkipCurrentSubTree;
      BEGIN
      SubTrees [Level] := VOID;
      END SkipCurrentSubTree;
      
    METHOD Next: NonTerminal;
      VAR
        p: ARRAY OF NonTerminal;
        GoOn: BOOLEAN;
      BEGIN
      GoOn := TRUE;
      WHILE GoOn DO
        IF Level < 0 THEN
          GoOn := FALSE;
         ELSIF SubTrees[Level] <> VOID THEN
          IF Position[Level] < SubTrees[Level].SIZE THEN
            GoOn := FALSE;
            END;
          END;
        IF GoOn THEN
          Level := Level - 1;
          END;
        END;
      IF Level < 0 THEN
        RESULT := VOID;
       ELSE
        RESULT := SubTrees [Level][Position[Level]];
        ASSERT RESULT <> VOID;
        p := PackSubTree(RESULT.SubTree);
        IF p <> VOID THEN
          Position [Level] := Position[Level] + 1;
          Level := Level + 1;
          SubTrees [Level] := p;
          Position [Level] := 0;
         ELSE
          Position [Level] := Position [Level] + 1;
          END;
        END;
      END Next;

  END Walker;
-----------------------------------------
  CLASS LimitedWalker(Class IN NonTerminal);
    INHERITS Walker;
        
    REDEFINE METHOD Next: Class; 
      VAR
        Tmp: NonTerminal;
      BEGIN
      Tmp := BASE;
      WHILE (Tmp <> VOID) AND (RESULT = VOID) DO
        IF Tmp <> VOID THEN
          WHAT Tmp OF
            IN Class:
              RESULT := TAG;
              END;
          ELSE    
            Tmp := BASE;
            END;
          END;  
        END;    
      END Next;
      
  END LimitedWalker;
  
END YaflParser;
