IMPLEMENTATION MODULE YaflModules;

IMPORT BitMap;
IMPORT YaflWorlds;
FROM Conversions IMPORT IntConversions;
FROM DateTime IMPORT Date, Time, Instant;
FROM Directories IMPORT DirectoryEntry, Operations;
FROM YaflLex IMPORT LexicalAnalyzer, Comment;
FROM Linked IMPORT LinkedList;
IMPORT LookAhead;
FROM YaflError IMPORT MainErrorHandler;
FROM YaflMethods IMPORT MethodDeclaration;
FROM YaflCfg IMPORT CurrentSpot, YaflCfg;
FROM YaflCreator IMPORT Creators;
FROM YaflDeclarations IMPORT Declaration;
FROM YaflPredefined IMPORT PredefItems, Void, VoidType;
FROM YaflParser IMPORT Walker;
IMPORT ModuleTable;
FROM Streams IMPORT StdOut, Stream, StdErr;
IMPORT String;
FROM YaflSymbols IMPORT SymbolTable;
IMPORT SYSTEM;
FROM YaflPragmas IMPORT IncludePragma;
FROM YaflStatements IMPORT Statement;
FROM YaflWorlds IMPORT World, DefaultWorld;
FROM YaflClImplementation IMPORT ClassImplementation;
FROM YaflDictionary IMPORT ClassReference;
FROM YaflController IMPORT Controller;

FROM YaflClasses IMPORT VirtualClassDecl;
FROM YaflNTList IMPORT NTList;
FROM YaflParamClasses IMPORT ClassActual, ClassActualSet;
FROM YaflWhat IMPORT WhatStatement;

----------------------------------------
  CLASS CompilationUnit(Component IN ClassDeclaration,
                        gc IN CompilationUnitCodeGenerator);
    INHERITS NonTerminal(gc);
    VAR
      TheImportList: ImportList;
      TheWorld: World;
      TheClasses: ClassList(Component);
      ThePragmas: DeclList(Pragma);
      TheSubDecls: MultiDeclList;
      
    METHOD SubDecls: MultiDeclList;
      BEGIN
      RESULT := TheSubDecls;
      END SubDecls;
      
    REDEFINE METHOD CREATE;
      BEGIN
      BASE (0, 0);
      TheSubDecls.CREATE;
      TheSubDecls.SetFather (THIS);
      TheClasses.CREATE;
      ThePragmas.CREATE;
      SubDecls.AppendList (TheClasses);            
      SubDecls.AppendList (ThePragmas);      
      END CREATE;
      
    METHOD Norm (a: ARRAY OF CHAR): ARRAY OF CHAR;
      VAR
        b: ARRAY OF CHAR;
        i: INTEGER;
      BEGIN
      b := a;
      i := String.Pos(b, '.');
      IF i < b.SIZE THEN
        b := b.SLICE (0, i);
        END;
      IF b.SIZE > 8 THEN
        b := b.SLICE(0, 8);
        END;
      RESULT := String.LowerCase(b);
      END Norm;
        
    METHOD CheckModuleName (ModName: ARRAY OF CHAR);
    
      BEGIN
      IF (Id <> VOID) AND (Id.Data <> VOID) AND 
         NOT String.Equals(Norm(ModName), Norm(Id.Data)) THEN
        Id.Error ("Non matching file and module name (" + ModName + '/' +
                                                          Id.Data + ")");         
        END;         
      END CheckModuleName;
                                  
    METHOD ParseImportList (Lkh: LookAhead);
      BEGIN
      IF NOT YaflCfg.Interrupted THEN
        TheImportList := Lkh.AcceptImportList;
        SetSon (TheImportList);
        END; -- IF
      END ParseImportList;

    METHOD GetImportList: ImportList;
      BEGIN
      RESULT := TheImportList;
      END GetImportList;

    REDEFINE METHOD SetFather(TheFather: NonTerminal);
      BEGIN
      ASSERT FALSE;
      END SetFather;
      
    METHOD Classes: ClassList(Component);
      BEGIN
      RESULT := TheClasses;
      END Classes;
      
      
    METHOD UniqueClass: Component;
      BEGIN
      IF Classes.Size = 1 THEN
        RESULT := Classes.Get(0);
        END;
      END UniqueClass;

    METHOD GetClass (ClassName: ARRAY OF CHAR): ClassDeclaration;
      VAR
        ClList: NTList(Component);
      BEGIN
      ClList := Classes;
      
      FOR i := 0 TO ClList.Size - 1 WHILE RESULT = VOID DO
        IF ClList.Get(i).Id.Data = ClassName THEN
          RESULT := ClList.Get(i);
          END;
        END;
      END GetClass;

    METHOD CheckHierarchy;
      VAR
        Walk: Walker;
        p: NonTerminal;
      BEGIN
      Walk.CREATE (THIS);
      p := Walk.Next;
      WHILE p <> VOID DO
        IF p <> THIS THEN
          IF p.GrandPa <> THIS THEN
            WHILE p <> VOID DO
              StdOut.WriteString (p.WhatAmI + " ");
              StdOut.WriteInt (p.LineNr, 6);
              StdOut.WriteInt (p.ColNr, 6);
              StdOut.WriteLn;
              p := p.Father;
              END;
            ASSERT FALSE;
            END;
          END;
        p := Walk.Next;
        END;
      END CheckHierarchy;

    VAR
      PragList: List(Pragma);

    METHOD AttachPragma(Prag: Pragma);
      BEGIN
      IF PragList = VOID THEN
        PragList.CREATE;
        END;
      PragList.Append (Prag);
      END AttachPragma;
      
    METHOD PragmaList: List(Pragma);
      BEGIN
      RESULT := PragList;
      END PragmaList;

    METHOD IncludePragmas: ARRAY OF ARRAY OF CHAR;
      BEGIN
      IF PragList <> VOID THEN
        FOR i := 0 TO PragList.Size -1 DO
          WHAT PragList.Get(i) OF
            IN IncludePragma:
              RESULT := RESULT + TAG.Includes;
              END; 
           ELSE
            -- Don't abort...
            END;
          END;
        END;
      END IncludePragmas;

    VAR
      TheLineCount: INTEGER;
            
    METHOD LineCount: INTEGER;
      BEGIN
      RESULT := TheLineCount;
      END LineCount;
      
    METHOD SetLineCount (Count: INTEGER);
      BEGIN
      TheLineCount := Count;
      END SetLineCount;

    VAR
      ErrFound: BOOLEAN;
            
    METHOD MarkError;
      BEGIN
      ErrFound := TRUE;
      END MarkError;
      
    METHOD ErrorFound: BOOLEAN;
      BEGIN
      RESULT := ErrFound;
      END ErrorFound;  
      
    VAR
      FirstPassTagFlag: BOOLEAN;
      
    METHOD FirstPassTagged: BOOLEAN;
      BEGIN
      RESULT := FirstPassTagFlag;
      END FirstPassTagged;
      
    VAR  
      TagInheritsClausesFlag: BOOLEAN;
      
    METHOD TagInheritsClauses;
      VAR
        OldErrorRef: CompilationUnit;
        ClList: DeclList(Component);
      BEGIN
      OldErrorRef := MainErrorHandler.Ref;
      MainErrorHandler.SetRef (THIS);

      SymbolTable.PushLevel;

      IF NOT YaflCfg.Interrupted THEN
        IF NOT TagInheritsClausesFlag THEN

          TagInheritsClausesFlag := TRUE;
          Classes.Enter; 

          TheImportList.UniqueTag; 
          
          IF NOT YaflCfg.Interrupted THEN
            TheImportList.EnterImportedSymbols;

            ClList := Classes;
            FOR i := 0 TO ClList.Size - 1 WHILE NOT YaflCfg.Interrupted DO
              ASSERT ClList.Get(i) <> VOID;

              ClList.Get(i).TagInheritsClause;
              END; -- FOR               
            END; -- IF
            
          END; -- IF
        END; -- IF  

      MainErrorHandler.SetRef (OldErrorRef);
      SymbolTable.PopLevel;
      END TagInheritsClauses;

    METHOD FirstPassTag;
      VAR
        OldErrorRef: CompilationUnit;
        ClList: DeclList(Component);
      BEGIN 
      OldErrorRef := MainErrorHandler.Ref;
      MainErrorHandler.SetRef (THIS);

      IF NOT YaflCfg.Interrupted THEN          

        IF NOT FirstPassTagFlag THEN

          FirstPassTagFlag := TRUE;

          ----------------------------------------
          -- First, go through the transitive closure, and tag
          -- inherits clauses.
          ----------------------------------------

          FOR t IN TransitiveClosure.Row | NOT t.IsTagged 
                      WHILE NOT YaflCfg.Interrupted DO
            t.TagInheritsClauses;
            END; -- FOR 
            
          IF NOT YaflCfg.Interrupted THEN
            TagInheritsClauses;

            SymbolTable.PushLevel;

            Classes.Enter; 

            IF NOT YaflCfg.Interrupted THEN
        TheImportList.UniqueTag;

              IF NOT YaflCfg.Interrupted THEN
          TheImportList.EnterImportedSymbols;
          ClList := Classes;
          FOR i := 0 TO ClList.Size - 1 WHILE NOT YaflCfg.Interrupted DO
            ASSERT ClList.Get(i) <> VOID;
            ClList.Get(i).FirstPassTag;
            END; -- FOR  
          END; -- IF   
        END; -- IF        
        SymbolTable.PopLevel;
            END; -- IF
          END; -- IF
  END; -- IF

      MainErrorHandler.SetRef (OldErrorRef);
      END FirstPassTag;

    VAR
      TheTranClosure,
      TheImported: ModuleSet;
      
    METHOD Imported: ModuleSet;
      BEGIN
      IF TheImported = VOID THEN
        TheImported := TheImportList.BuildSet;
        END;
      RESULT := TheImported;
      END Imported;
      
    METHOD ComputeTransitiveClosure: ModuleSet;
      BEGIN
      IF GetImportList <> VOID THEN
        RESULT := GetImportList.TransitiveClosure;
        END;
      IF RESULT = VOID THEN
        RESULT.CREATE;
        END;
      END ComputeTransitiveClosure;
      
-------------------------------------------------
-- The TransitiveClosure method is based on a on demand
-- unique evaluation scheme which calls the ComputeTransitiveClosure
-- method to compute the actual transitive closure of imported
-- modules. This two-method scheme is required to allow the
-- ImplementationModule class to define a specific behaviour for
-- its transitive closure computing without losing or duplicating
-- the unique evaluation mechanism.
-------------------------------------------------      
    METHOD TransitiveClosure: ModuleSet;
      BEGIN
      IF TheTranClosure = VOID THEN
        TheTranClosure := ComputeTransitiveClosure;
        ASSERT TheTranClosure <> VOID;
        END;
      RESULT := TheTranClosure;
      END TransitiveClosure;
      
    METHOD SetWorld (TheWorld: World);
      BEGIN
      THIS.TheWorld := TheWorld;      
      END SetWorld;
      
    METHOD GetWorld: World;
      BEGIN
      RESULT := THIS.TheWorld;
      END GetWorld;
      
    ----------------------------
    -- Comment map handling methods.
    ----------------------------
    
    VAR
      TheCommentMap: BitMap;
      
    METHOD BuildCommentMap (CommArray: ARRAY OF Comment);
      BEGIN
      IF CommArray.SIZE = 0 THEN
        TheCommentMap := VOID;
       ELSE
        --------------
        -- Prepare room for 64 more bits, just in case rounding
        -- might be a bit limited.
        --------------
        TheCommentMap.CREATE (CommArray[CommArray.SIZE - 1].LineNr + 64); 
        FOR i := 0 TO CommArray.SIZE - 1 DO
          IF NOT CommArray[i].IsTrivial THEN
            TheCommentMap.Set (CommArray[i].LineNr);
            END;
          END;
        END;
      END BuildCommentMap;
      
   METHOD CommentsCount: INTEGER;
     BEGIN
     IF TheCommentMap <> VOID THEN
       FOR i := 0 TO TheCommentMap.Size - 1 DO
         IF TheCommentMap.Get(i) THEN
           RESULT := RESULT + 1;
           END;
         END;
       END;
     END CommentsCount;
      

    VAR
      TheRef : ModuleReference;
        
    METHOD Reference : ModuleReference;
      BEGIN
      IF TheRef = VOID THEN      
        TheRef := ModuleDictionary.FindModule (Id.Data);
        END; -- IF
      RESULT := TheRef; 
      END Reference;      
           
    VAR
      Done : BOOLEAN;
                    
    METHOD EnterImportsInDictionary;
      VAR
        Imports  : ARRAY OF DefinitionModule;
        BEGIN                        
      IF NOT YaflCfg.Interrupted THEN
        IF NOT Done AND IsTagged THEN
          Done := TRUE;
          Imports := TransitiveClosure.Row;
          FOR TheCount := 0 TO Imports.SIZE -1 
                            WHILE NOT YaflCfg.Interrupted DO 
            CurrentSpot.PushCurrentModule(Imports[TheCount]);
            Imports [TheCount].EnterInDictionary;
            CurrentSpot.PopCurrentModule;
            END; -- FOR 
          Done := FALSE;  
          END; 
        END; 
      END EnterImportsInDictionary;      
      
    METHOD EnterInDictionary;
    
      BEGIN               
      IF NOT YaflCfg.Interrupted THEN   
        YaflCfg.GetController.Capture (Controller.Entering);
              YaflCfg.GetController.SetMessage (Id.Data);
      
        DEBUG 
          IF YaflCfg.VerboseLevel > 2 THEN
            StdOut.WriteLine (WhatAmI + "(" +
                              IntConversions.IntToString (Id.LineNr, 0) +
                              "," +
                              IntConversions.IntToString (Id.ColNr, 0) +
                              ") : " + Id.Data + " : Enter In Dictionary");
            END;
          END; -- DEBUG
         
        Reference.SetState (State);  
        Reference.SetWorld (GetWorld.Prefix);
        ASSERT IsTagged;
        UniqueCheckType;
        ASSERT IsTypeChecked;
        FOR Cl IN Classes DO
          ASSERT Cl.IsTypeChecked;
          CurrentSpot.PushCurrentClass(Cl);
          Cl.EnterInDictionary;
          CurrentSpot.PopCurrentClass;
          END;
          
        END;
      END EnterInDictionary;  
                   
    METHOD ClearSubGc;
      VAR
        TheWalker: Walker;
        TheNT: NonTerminal;
      BEGIN
      -- IF YaflCfg.VerboseLevel > 1 THEN
      --   StdOut.WriteLine("Pruning Code Generators from " + WhatAmI + ": " + Id.Data);
      --   END;
      TheWalker.CREATE(THIS);
      TheNT := TheWalker.Next;
      WHILE TheNT <> VOID DO
        TheNT.ClearGc;
        TheNT := TheWalker.Next;
        END;
      END ClearSubGc;
      
    METHOD TagMethodHeaders;
      BEGIN
      SymbolTable.PushLevel;
      CurrentSpot.PushCurrentModule(THIS);
      Classes.Enter; 
      GetImportList.Enter;
      FOR i := 0 TO TheClasses.Size - 1 DO
        TheClasses.Get(i).TagMethodHeaders;
        END;  
      CurrentSpot.PopCurrentModule;
      SymbolTable.PopLevel;
      END TagMethodHeaders;

    METHOD TagAssertions;
      BEGIN
      SymbolTable.PushLevel;
      CurrentSpot.PushCurrentModule(THIS);
      Classes.Enter; 
      GetImportList.Enter;
      FOR i := 0 TO TheClasses.Size - 1 DO
        TheClasses.Get(i).TagAssertions;
        END;  
      CurrentSpot.PopCurrentModule;
      SymbolTable.PopLevel;
      END TagAssertions;
      
    METHOD TagClosure;
      VAR
        ToAdd,
        Tran: ARRAY OF DefinitionModule;
      BEGIN
      FirstPassTag;
      TagAssertions;
      IF NOT YaflCfg.Interrupted THEN
        ----------------------------------------
        -- First, go through the transitive closure, and
        -- tag inheritance and limiting clauses
        ----------------------------------------
        Tran := TransitiveClosure.Row;
        ToAdd.CREATE(1);
        ToAdd[0] := Canonic;
        Tran := Tran + ToAdd;
        
        FOR i := 0 TO Tran.SIZE - 1 DO
          IF Tran[i].IsTagged THEN
            Tran[i] := VOID;
            END;
          END;
                
        FOR t IN Tran |  t <> VOID WHILE NOT YaflCfg.Interrupted DO
          t.FirstPassTag;
          END; -- FOR
        FOR t IN Tran |  t <> VOID WHILE NOT YaflCfg.Interrupted DO
          t.TagMethodHeaders;
          END; -- FOR
        FOR t IN Tran |  t <> VOID WHILE NOT YaflCfg.Interrupted DO
          t.TagAssertions;
          END; -- FOR
          
        FOR t IN Tran |  t <> VOID WHILE NOT YaflCfg.Interrupted DO
          t.UniqueTag;
          ASSERT t.IsTagged;  -- Now, the trouble is over
                              -- This module won't have to
                              -- be tagged ever again ...
          END; -- FOR
        END; -- IF
      END TagClosure;
      
      
    METHOD Publish: BOOLEAN;
      BEGIN
      RESULT := THERE_IS Cl IN Classes :- Cl.Publish;
      END Publish;

  END CompilationUnit;

----------------------------------------

  CLASS ModuleSet;
    INHERITS NTSet(DefinitionModule);
    
    METHOD TransitiveClosure: ModuleSet;
      BEGIN
      RESULT.CREATE;
      FOR p IN Row DO
        RESULT.DoUnion (p.TransitiveClosure);
        END;
      END TransitiveClosure;
      
  END ModuleSet;

----------------------------------------

  CLASS DefinitionModule;
    INHERITS CompilationUnit(ClassDefinition, DefModuleCodeGenerator);
    VAR
      TheUnitName: Ident;

    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE(2);
      RESULT[0] := TheUnitName;
      RESULT[1] := GetImportList;
      RESULT := RESULT + Classes.SubTree;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      VAR           
        EndId: Ident;
        OldCount: INTEGER;
      BEGIN
      IF NOT YaflCfg.Interrupted THEN

        OldCount := MainErrorHandler.ErrorCount;
        Lkh.Accept (LexicalAnalyzer.Definition);
        Lkh.Accept (LexicalAnalyzer.Module);
        TheUnitName := Lkh.AcceptIdent;
        SetSon (TheUnitName);
        Lkh.Accept (LexicalAnalyzer.SemiColon);

        ParseImportList (Lkh);

        IF NOT YaflCfg.Interrupted THEN
          SubDecls.AppendFromList(Lkh.AcceptDeclarationList(
                                  FALSE, LookAhead.ModuleContext));
          Lkh.Accept (LexicalAnalyzer.End);
          EndId := Lkh.AcceptIdent;
          IF (EndId <> VOID) AND (EndId.Data <> Id.Data) THEN
            EndId.Error ("Non matching closing identifier (" + 
                          EndId.Data + "/" + Id.Data + ")");
            END; -- IF
          Lkh.Accept (LexicalAnalyzer.SemiColon);
          Lkh.Accept (LexicalAnalyzer.Eof);
          ---------------------------
          -- If we're supposed to gather metrics information,
          -- we must first build the bitmap which represents the
          -- mapping of comments in the compiled source file.
          ---------------------------
          IF YaflCfg.PleaseGenerateMetrics AND (Lkh.CommentPool <> VOID) THEN
            BuildCommentMap (Lkh.CommentPool.Row);
            Lkh.ResetCommentPool;
            END; -- IF
          IF OldCount <> MainErrorHandler.ErrorCount THEN
            MarkError;
            DEBUG          
              StdOut.WriteLine ("Mark Error while parsing " + 
                                WhatAmI + " " + Id.Data);
              END; -- DEBUG
            END; -- IF

          BASE (Lkh);   
          SetLineCount (Lkh.LineNr);
          ASSERT IsParsed;
          END; -- IF
        END; -- IF
      END Parse;

    REDEFINE METHOD Id: Ident;
      BEGIN
      RESULT := TheUnitName;
      END Id;

    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "DefinitionModule";
      END WhatAmI;

    REDEFINE METHOD Tag;
      VAR
        OldErrorRef: CompilationUnit;
      BEGIN  
      SymbolTable.Check;
      CurrentSpot.PushCurrentModule (THIS);
      IF NOT YaflCfg.Interrupted THEN
        -------------------------------
        -- In some obscure case, the semantic analysis pass may be
        -- started, even in a situation where a previous pass generated
        -- some kind of error. In order to circumvent this undesired effect,
        -- we simply check whether an error as already been attached to THIS,
        -- and discard the rest of the analysis if it has.
        -------------------------------
        OldErrorRef := MainErrorHandler.Ref;
        MainErrorHandler.SetRef (THIS);
        
        -------------------------------
        -- Under normal circumstances, the FirstPassTag method
        -- must have been called before the Tag method in order
        -- to guarantee correct evaluation of cyclic references
        -- in definition modules.
        --
        -- However, in order to make the whole system more robust,
        -- FirstPassTag is called explicitely in case it had not been
        -- before. At first sight, it should seldom cause true problems,
        -- since the cases where the cyclic references were a true problem 
        -- were pretty rare, but who knows...
        -------------------------------
        IF NOT FirstPassTagged THEN
          FirstPassTag;
          END; -- IF
        
        IF NOT YaflCfg.Interrupted THEN  


          Id.SetRef (THIS);

          SymbolTable.PushLevel;

          ---------------------------------------
          -- Attach the identifier to it's class definitions 
          -- inside this module
          ---------------------------------------

          Classes.Enter;

          ---------------------------------------
          -- Tag the IMPORT clauses attached to this module;
          ---------------------------------------

          GetImportList.Enter;
          GetImportList.UniqueTag;
           
          IF NOT YaflCfg.Interrupted THEN
            IF GetImportList.ErrorFound THEN
              Error ("Compilation aborted due to an error in " + 
                     "imported module (" + 
                      GetImportList.OffendingImport.Id.Data + ")");
             ELSE
              Classes.Enter;
              SubDecls.UniqueTag;
              END; -- IF

            IF NOT YaflCfg.Interrupted THEN
              BASE;
              END; -- IF     
            END; -- IF

          SymbolTable.PopLevel;

          END; -- IF
        MainErrorHandler.SetRef (OldErrorRef);
        END; -- IF
      CurrentSpot.PopCurrentModule;
      END Tag;
      
    VAR
      TypeChecked: BOOLEAN;
      
    REDEFINE METHOD CheckType;
      VAR
        OldErrorRef: CompilationUnit;
      BEGIN
      IF NOT TypeChecked THEN
        CurrentSpot.PushCurrentModule (THIS);
        OldErrorRef := MainErrorHandler.Ref;
        MainErrorHandler.SetRef (THIS);
        TypeChecked := TRUE;
        GetImportList.CheckTypeImportedModules;
        Classes.UniqueCheckType;
        MainErrorHandler.SetRef (OldErrorRef);
        CurrentSpot.PopCurrentModule;
        END;
      END CheckType;
      
    METHOD Canonical: BOOLEAN;
      BEGIN
      RESULT := (Classes.Size = 1) AND (Classes.First.Id.Data = Id.Data);
      END Canonical;
      
    METHOD HeaderFName (MainModule: ImplementationModule;
                        Pass: INTEGER): ARRAY OF CHAR;
      VAR
        TheWorld: World;                        
      BEGIN                                              
      IF NOT YaflCfg.PleaseGenerateAbsolutePathNames AND
            (MainModule <> VOID) AND (MainModule.GetWorld = GetWorld) THEN
        TheWorld := DefaultWorld;
       ELSE
        TheWorld := GetWorld;
        END;
      ASSERT TheWorld <> VOID;
      RESULT := TheWorld.BuildTargetFName (Id.Data, YaflCfg.HeaderExt + 
                         IntConversions.IntToString (Pass, 0));
      IF YaflCfg.PleaseGenerateAbsolutePathNames THEN
        RESULT := YaflCfg.NameMapper.MakeAbsolute (RESULT);
        END;
      END HeaderFName;

    VAR
      TheImplementationImported: ModuleSet;
      
    METHOD ImplementationImported: ModuleSet;
      BEGIN
      RESULT := TheImplementationImported;
      END ImplementationImported;

    METHOD SetImplementationImported(TheSet: ModuleSet);
      BEGIN
      TheImplementationImported := TheSet;
      END SetImplementationImported;
      
    METHOD CombinedImported: ModuleSet;
      BEGIN
      IF Imported = VOID THEN
        RESULT := TheImplementationImported;
       ELSIF TheImplementationImported = VOID THEN
        RESULT := Imported;
       ELSE
        ASSERT TheImplementationImported <> VOID;
        WHAT Imported.Union (TheImplementationImported) OF
          IN ModuleSet:
            RESULT := TAG; 
            END;
          END;
        END;
      END CombinedImported; 
      
    METHOD ComputeVersionKey(Pass: INTEGER): ARRAY OF CHAR;
      VAR
        Entry: DirectoryEntry;
        TheDate: Date;
        TheTime: Time;
      BEGIN                 
      Entry := Operations.GetEntry (HeaderFName(VOID, Pass));
      IF Entry = VOID THEN
        RESULT := "0";
       ELSE       
        TheDate := Entry.LastModification.GetDate;
        TheTime := Entry.LastModification.GetTime;
        RESULT := IntConversions.IntToString (TheDate.Day, 2) + 
                  IntConversions.IntToString (TheDate.Month, 2) + 
                  IntConversions.IntToString (TheDate.Year, 2) +
                  '_' +
                  IntConversions.IntToString (TheTime.Hour, 2) + 
                  IntConversions.IntToString (TheTime.Minute, 2) + 
                  IntConversions.IntToString (TheTime.Second, 2);
        FOR i := 0 TO RESULT.SIZE - 1 DO
          IF RESULT[i] = ' ' THEN
            RESULT[i] := '0';
            END;
          END;
        END;
      END ComputeVersionKey;
      
    VAR
      TheVersionKey: ARRAY OF CHAR;

    METHOD VersionKey: ARRAY OF CHAR;
      BEGIN
      IF TheVersionKey = VOID THEN
        TheVersionKey := ComputeVersionKey(1)+'_'+ComputeVersionKey(2);
        END;
      ASSERT TheVersionKey <> VOID;
      RESULT := TheVersionKey;
      END VersionKey;
      
    METHOD ResetVersionKey;
      BEGIN
      TheVersionKey := VOID;
      END ResetVersionKey;
      
    REDEFINE METHOD EnterInDictionary;      
      BEGIN              
      IF NOT YaflCfg.Interrupted THEN
        BASE;         

        ASSERT Reference <> VOID;
      
        Reference.SetDeclPos (Id.ColNr, Id.LineNr);
        END; -- IF
      END EnterInDictionary;
           
    REDEFINE METHOD SourceFileName: ARRAY OF CHAR;
      BEGIN
      RESULT := GetWorld.BuildSourceFName (Id.Data, YaflCfg.DefExt);
      END SourceFileName;

    REDEFINE METHOD Canonic: DefinitionModule;
      BEGIN
      RESULT := THIS;
      END Canonic;
      
  END DefinitionModule;

----------------------------------------

 CLASS ImplementationModule;
    INHERITS CompilationUnit(ClassImplementation, ImplModuleCodeGenerator);
    VAR
      TheUnitName: Ident;
      TheInline: InLineStatement;
      TheDefModule: DefinitionModule;
      --------------------------
      -- The EndId attributes keeps track of the
      -- closing identifier of the module. It used
      -- to be read in the Parse method, and discarded
      -- afterwards, but it was required for the debugger
      -- to be able to know where the class starts and stops.
      --------------------------
      EndId: Ident; 

    METHOD EndIdent:Ident; 
      BEGIN
      RESULT := EndId;
      END EndIdent;

    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE (3);
      RESULT[0] := TheUnitName;
      RESULT[1] := GetImportList;
      RESULT[2] := TheInline;
      RESULT := RESULT + Classes.SubTree;
      END SubTree;
      
    METHOD ParseUntilImportList (Lkh: LookAhead);
      BEGIN
      Lkh.Accept (LexicalAnalyzer.Implementation);
      Lkh.Accept (LexicalAnalyzer.Module);
      TheUnitName := Lkh.AcceptIdent;
      SetSon (TheUnitName);
      Lkh.Accept (LexicalAnalyzer.SemiColon);
      ParseImportList (Lkh);

      IF NOT YaflCfg.Interrupted THEN
        IF Lkh.CurrentToken = LexicalAnalyzer.Inline THEN
          TheInline.CREATE(Lkh.LineNr, Lkh.ColNr);
          TheInline.Parse (Lkh);
          Lkh.Accept (LexicalAnalyzer.SemiColon);
          END; -- IF
        SetSon (TheInline);
        END; -- IF
      END ParseUntilImportList;
      
    METHOD ParseAfterImportList(Lkh: LookAhead);
      VAR
        St: INTEGER;
      BEGIN
      WHILE NOT Lkh.Ok DO  -- Try To Synchronize
        St := Lkh.CurrentToken;
        CASE St OF
          LexicalAnalyzer.Class,
          LexicalAnalyzer.Inline,
          LexicalAnalyzer.Eof:
            Lkh.Reset;
            END;
         ELSE    -- Otherwise, Skip...
          Lkh.GetToken;
          END;
        END;
        
      SubDecls.AppendFromList (Lkh.AcceptDeclarationList(TRUE, 
                               LookAhead.ModuleContext));

      Lkh.Accept (LexicalAnalyzer.End);
      EndId := Lkh.AcceptIdent;
      IF (EndId <> VOID) AND (EndId.Data <> Id.Data) THEN
        EndId.Error ("Non matching closing identifier (" + 
                     EndId.Data + "/" + Id.Data + ")");
        END; -- IF
      Lkh.Accept (LexicalAnalyzer.SemiColon);
      Lkh.Accept (LexicalAnalyzer.Eof);
      ---------------------------
      -- If we're supposed to gather metrics information,
      -- we must first build the bitmap which represents the
      -- mapping of comments in the compiled source file.
      ---------------------------
      IF YaflCfg.PleaseGenerateMetrics AND (Lkh.CommentPool <> VOID) THEN
        BuildCommentMap (Lkh.CommentPool.Row);
        Lkh.ResetCommentPool;
        END;
      END ParseAfterImportList;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      IF NOT YaflCfg.Interrupted THEN
      
        ParseUntilImportList (Lkh);    
        
        IF NOT YaflCfg.Interrupted THEN
          ParseAfterImportList (Lkh);

          BASE (Lkh);
          SetLineCount (Lkh.LineNr);
          END; -- IF   
        END; -- IF
      END Parse;

    REDEFINE METHOD Id: Ident;
      BEGIN
      RESULT := TheUnitName;
      END Id;

    METHOD InLine: InLineStatement;
      BEGIN
      RESULT:= TheInline;
      END InLine;

    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "ImplementationModule";
      END WhatAmI;

    REDEFINE METHOD Tag;
      VAR
        ErrorFound: BOOLEAN;
      BEGIN
      SymbolTable.Check;
      IF NOT YaflCfg.Interrupted THEN

        ----------------------------------------
        -- Make sure there have been no
        -- error in the previous passes
        ----------------------------------------

        SymbolTable.PushLevel;

        IF MainErrorHandler.ErrorCount = 0 THEN

          ----------------------------------------
          -- Memorize the current Implementation Module
          ----------------------------------------

          CurrentSpot.PushCurrentModule (THIS);

          ----------------------------------------
          -- Attach the implementation module to the corresponding
          -- definition module
          ----------------------------------------

          VOID := DefModule;

          ----------------------------------------
          -- Mark the module's identifier as referring to THIS.
          ----------------------------------------

          Id.SetRef (THIS);
          IF (TheDefModule <> VOID) AND NOT TheDefModule.ErrorFound THEN
            IF TheDefModule.Id.Data <> Id.Data THEN
              Error ("Non matching definition and implementation module names");
              END; -- IF

            ----------------------------------
            -- Perform inheritance and limiting clauses tag
            -- for the classes listed in THIS (implementation module).
            ----------------------------------
            TagClosure;
            END;
            
          ----------------------------------------
          -- Abort compilation here if any error has been encountered
          -- while tagging the transitive closure of imported modules.
          ----------------------------------------

          ErrorFound := TheDefModule.ErrorFound;
          IF (ErrorFound) AND (NOT YaflCfg.Interrupted) THEN
            Error ("Compilation aborted due to error in imported modules");
           ELSE 
            IF NOT YaflCfg.Interrupted THEN
              ----------------------------------------
              -- Attach the identifiers to all class 
              -- declarations inside this module
              ----------------------------------------
              Classes.SetFather (THIS);
              Classes.Enter;

              SymbolTable.PushLevel;
              
              IF NOT YaflCfg.Interrupted THEN
                ----------------------------------------
                -- Make the IMPORT clauses from the DEFINITION 
                -- MODULE visible to the IMPLEMENTATION MODULE
                ----------------------------------------
                IF (TheDefModule <> VOID) THEN
                  TheDefModule.GetImportList.TagImportDef;
                  TheDefModule.GetImportList.Enter;
                  END; -- IF
  
                IF NOT YaflCfg.Interrupted THEN
                  ----------------------------------------
                  -- Tag the IMPORT clauses attached to this module
                  ----------------------------------------
                  GetImportList.Enter;
                  GetImportList.UniqueTag;

                  IF NOT YaflCfg.Interrupted THEN
                    ----------------------------------------------------
                    -- First, Tag all the method headers
                    ----------------------------------------------------
                    FOR Cl IN Classes DO
                      Cl.TagMethodHeaders;            
                      END; -- FOR   

                    ----------------------------------------------------
                    -- Tag all the classes of the IMPLEMENTATION MODULE;
                    -- and the intermixed pragmas
                    ----------------------------------------------------
                    SubDecls.UniqueTag;

                    BASE;   
                    END; -- IF
                  END; -- IF
                END; -- IF
              SymbolTable.PopLevel;
              END; -- IF   
            END; -- IF   
          CurrentSpot.PopCurrentModule;
          END; -- IF
        SymbolTable.PopLevel;
        END; -- IF   
      END Tag;

    REDEFINE METHOD CheckType;
      BEGIN
      DefModule.UniqueCheckType;
      IF Classes.Size > 0 THEN
        ----------------------------------------
        -- Memorise the current Implementation Module
        ----------------------------------------
        CurrentSpot.PushCurrentModule (THIS);
        Classes.UniqueCheckType;
        CurrentSpot.PopCurrentModule;
        END;
      CheckConformity;
      END CheckType;

    METHOD DefModule: DefinitionModule;
      BEGIN
      IF TheDefModule = VOID THEN
        TheDefModule := ModuleTable.GetDefinitionModule (GetWorld, Id.Data);
        END;
      RESULT := TheDefModule;
      END DefModule;

    METHOD GetClassImplementation(ClassName: ARRAY OF CHAR): 
                                          ClassImplementation;
      VAR
        ClList: DeclList(ClassImplementation);
      BEGIN
      ClList := Classes;
      FOR i := 0 TO ClList.Size - 1 WHILE RESULT = VOID DO
        IF ClList.Get(i).Id.Data = ClassName THEN
          RESULT := ClList.Get(i);
          END;
        END;      
      END GetClassImplementation;                                          

    REDEFINE METHOD GetClass (ClassName: ARRAY OF CHAR): ClassDeclaration;
      BEGIN
      IF TheDefModule <> VOID THEN
        RESULT := TheDefModule.GetClass (ClassName);
       ELSE
        RESULT := BASE (ClassName);
        END;
      END GetClass;

    METHOD CheckConformity;
      VAR
        ClList: DeclList(ClassImplementation);
        ClDefList: DeclList(ClassDefinition);
        
        METHOD CheckClass (ImplClasses: DeclList (ClassImplementation);
                           ClassDef: ClassDefinition);
          VAR
            Found: BOOLEAN;                           
          BEGIN          
          FOR i := 0 TO ImplClasses.Size - 1 WHILE NOT Found DO
            Found := ImplClasses.Get(i).Id.Data = ClassDef.Id.Data;
            END; -- FOR
          IF NOT Found THEN
            ClassDef.Error ("Class not implemented (" + 
                             ClassDef.Id.Data + ")");
            END; -- IF 
          END CheckClass;
        
      BEGIN
      ClList := Classes;
      FOR i := 0 TO ClList.Size - 1 DO
        ClList.Get(i).CheckConformity;
        END; -- FOR
      ------------------------------------
      -- Now, let's make sure that all the classes
      -- listed in the definition module are present
      -- in the corresponding implementation module.
      ------------------------------------ 
      ASSERT DefModule <> VOID;
      ClDefList := DefModule.Classes;
      FOR i := 0 TO ClDefList.Size - 1 DO
        CheckClass (ClList, ClDefList.Get(i));
        END; -- FOR
      END CheckConformity;

    ------------------------------
    -- The GeneratedLines returns the total number of lines
    -- which have been generate while compiling this
    -- ImplementationModule.    
    ------------------------------    
    METHOD GeneratedLines: INTEGER;
      BEGIN
      RESULT := Gc.GeneratedLines;
      END GeneratedLines;
      
    REDEFINE METHOD ComputeTransitiveClosure: ModuleSet;
      VAR
        p: ARRAY OF DefinitionModule;
        BEGIN
      RESULT := BASE;
      RESULT.Add (DefModule);
      IF DefModule <> VOID THEN
        p := DefModule.TransitiveClosure.Row;
        FOR i := 0 TO p.SIZE - 1 DO
          RESULT.Add(p[i]);
          END;
        END;
      END ComputeTransitiveClosure;
      
    REDEFINE METHOD FirstPassTag;
      BEGIN
      IF NOT YaflCfg.Interrupted THEN
        SymbolTable.PushLevel;
        IF (DefModule <> VOID) THEN
          DefModule.GetImportList.Enter;
          END;
        BASE;
        SymbolTable.PopLevel;
        END; -- IF
      END FirstPassTag;
      
    ------------------------------
    -- See the definition for more information regarding this
    -- method.
    ------------------------------
    METHOD ProjectClosure: ModuleSet;
    
      VAR
        Res: ModuleSet;
        p: ARRAY OF DefinitionModule;
         j: INTEGER;
        ToVisit: List(DefinitionModule);
    
      METHOD Enter (DefModule: DefinitionModule);
        VAR
          p: ARRAY OF DefinitionModule;
          ImpList: ImportList;
        BEGIN
        IF NOT Res.Includes(DefModule) THEN
          Res.Add(DefModule);
          ASSERT Res.Includes(DefModule);
          IF YaflCfg.VerboseLevel > 0 THEN
            StdOut.WriteLine ("Reading implementation module: " +
                               DefModule.Id.Data);
            END;
          ImpList := ModuleTable.GetImplementationModuleImportList
                                                     (DefModule.GetWorld,
                                                      DefModule.Id.Data);
          IF ImpList <> VOID THEN
            p := ImpList.TransitiveClosure.Row;
            FOR i := 0 TO p.SIZE - 1 DO
              IF NOT Res.Includes(p[i]) THEN
                ToVisit.Append (p[i]);
                END;
              END;
            END;                                            
          IF YaflCfg.StripMemMode THEN
            YaflCfg.GarbageCollector;
            END;
          END;
        END Enter;
        
      BEGIN
      Res.CREATE;
      ASSERT DefModule <> VOID;
      Res.Add (DefModule);
      ToVisit.CREATE;
      p := TransitiveClosure.Row;
      FOR i := 0 TO p.SIZE - 1 DO
        ToVisit.Append (p[i]);
        END;
      j := 0;
      WHILE j < ToVisit.Size DO
        Enter (ToVisit.Get(j));
        j := j + 1;
        END;      
      RESULT := Res;
      END ProjectClosure;
      
    METHOD CyclomaticComplexity: INTEGER;
      VAR
        ClList: DeclList(ClassImplementation);
      BEGIN  
      ClList := Classes;
      FOR i := 0 TO ClList.Size - 1 DO
        RESULT := RESULT + ClList.Get(i).CyclomaticComplexity;
        END;
      END CyclomaticComplexity;                               
 

    METHOD RemoveDebug;
      BEGIN                  
      IF Classes <> VOID THEN
        FOR i := 0 TO Classes.Size-1 DO
          Classes.Get(i).RemoveDebug;
          END;
        END;
      END RemoveDebug;
           
    REDEFINE METHOD EnterInDictionary;
    
      METHOD MarkActualClasses;
        VAR
          p        : List(ClassActual);
          q        : List(WhatStatement);
          TheClass : ClassDeclaration;
        BEGIN
        p.CREATE;
        GrabSubNodes(p);
        FOR i := 0 TO p.Size-1 DO
          TheClass := p.Get(i).Class;
          WHAT TheClass OF
            IN VirtualClassDecl:
              END;
           ELSE
            TheClass.Reference.DoKeepDual;
            END;
          END;
         
        q.CREATE;       
        GrabSubNodes(q);
        FOR i := 0 TO q.Size-1 DO
          q.Get(i).MarkRequiredClasses;
          END;
        END MarkActualClasses;
        
      BEGIN              
      CurrentSpot.PushCurrentModule (THIS);
      IF NOT YaflCfg.Interrupted THEN
        BASE;  

        ASSERT Reference <> VOID;
        Reference.SetImplPos (Id.ColNr, Id.LineNr);
       
        IF DefModule <> VOID THEN
          DefModule.EnterInDictionary;
          END; 
        END; 
      MarkActualClasses;                                            
      CurrentSpot.PopCurrentModule;
      END EnterInDictionary;
           
    METHOD RemoveUnused;
      VAR
        ClassRef : ClassReference;
        Class    : ClassImplementation;
      BEGIN
      FOR i := Classes.Size - 1 TO 0 BY -1 DO
        Class := Classes.Get(i);
        ClassRef := Class.Reference;
        IF ClassRef.Removed THEN
          Class.Remove;
         ELSE                           
          Class.RemoveUnused;
          END;
        END;
      END RemoveUnused;
      
    METHOD AttachToCurrentWorld;
      BEGIN
      SetWorld (YaflWorlds.DefaultWorld);
      END AttachToCurrentWorld;

    METHOD ClearAllGc;
      VAR
        Tran: ARRAY OF DefinitionModule;
        BEGIN
      ClearSubGc;
      ClearGc;
      Tran := TransitiveClosure.Row;
      FOR i := 0 TO Tran.SIZE - 1 DO
        Tran[i].ClearSubGc;
        Tran[i].ClearGc;
        END; 
      PredefItems.ClearGc;
      Void.ClearGc;
      VoidType.ClearGc;
      END ClearAllGc;

    METHOD UsesInline: BOOLEAN;
      BEGIN
      RESULT := THERE_IS Cl IN Classes :- Cl.UsesInline;
      END UsesInline;       
 
    REDEFINE METHOD SourceFileName: ARRAY OF CHAR;
      BEGIN
      RESULT := GetWorld.BuildSourceFName (Id.Data, YaflCfg.ImpExt);
      END SourceFileName;
      
    REDEFINE METHOD Canonic: DefinitionModule;
      BEGIN
      RESULT := DefModule;
      END Canonic;
      
  END ImplementationModule;

END YaflModules;
