IMPLEMENTATION MODULE YaflParamClasses;

IMPORT Ref;
FROM Streams IMPORT StdOut;
FROM YaflSymbols IMPORT SymbolTable;
FROM LookAhead IMPORT LookAhead;
FROM YaflClasses IMPORT VirtualClassDecl;
FROM YaflClImplementation IMPORT ClassImplementation;
FROM YaflDeclarations IMPORT Declaration;
FROM YaflMethods IMPORT MethodDeclaration;
FROM YaflPredefined IMPORT PredefClass;

  CLASS ClassActualSet;
    INHERITS NonTerminal(DummyNTCodeGenerator);
    
    VAR
      TheActualList: NTList(ClassActual);
      TheConstrained: ConstrainedClassDecl;
      
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT := TheActualList.SubTree;
      END SubTree;
    
    REDEFINE METHOD CREATE (LineNr, ColNr: INTEGER);
      BEGIN
      TheActualList.CREATE;
      BASE(LineNr, ColNr);
      END CREATE;
      
    METHOD SetConstrained(Constrained: ConstrainedClassDecl);
      BEGIN
      TheConstrained := Constrained;
      END SetConstrained;
      
    METHOD Constrained: ConstrainedClassDecl;
      BEGIN
      RESULT := TheConstrained;
      END Constrained;
      
    METHOD ActualList: NTList(ClassActual);
      BEGIN
      RESULT := TheActualList;
      END ActualList;
    
    REDEFINE METHOD Parse (Lkh: LookAhead);
      VAR
        Act: ClassActual;
      BEGIN
      Lkh.Accept (Lkh.LeftParen);
      Act.CREATE (THIS, Lkh.LineNr, Lkh.ColNr);
      Act.Parse (Lkh);
      TheActualList.Append (Act);
      WHILE (Lkh.CurrentToken <> Lkh.RightParen) AND (Lkh.Ok) DO
        Lkh.Accept (Lkh.Comma);
        Act.CREATE (THIS, Lkh.LineNr, Lkh.ColNr);
        Act.Parse (Lkh);
        TheActualList.Append (Act);
        END;
      Lkh.Accept (Lkh.RightParen);
      END Parse;
      
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN       
      RESULT := "ClassActualSet";
      END WhatAmI;
      
    REDEFINE METHOD Tag;
      BEGIN   
      TheActualList.UniqueTag;
      END Tag;
      
    METHOD Match (Other: ClassActualSet): BOOLEAN;
      BEGIN
      IF TheActualList.Size = Other.TheActualList.Size THEN
        RESULT := TRUE;
        FOR i := 0 TO TheActualList.Size - 1 WHILE RESULT DO
          RESULT := TheActualList.Get(i).Match(Other.TheActualList.Get(i));
          END;
        END;
      END Match;
      
    METHOD Size: INTEGER;
      BEGIN
      RESULT := TheActualList.Size;
      END Size;
      
    METHOD SetFromArray (Arr: ARRAY OF ClassActual);
      BEGIN
      ASSERT Size = 0;
      FOR i := 0 TO Arr.SIZE - 1 DO
        TheActualList.Append (Arr[i]);
        END;      
      END SetFromArray;
      
    METHOD Enter;
      BEGIN
      FOR i := 0 TO ActualList.Size - 1 DO
        ActualList.Get(i).Enter;
        END;
      END Enter;
      
  END ClassActualSet;
  ----------------------------------
  CLASS ClassActual;
    INHERITS NonTerminal(DummyNTCodeGenerator);
    
    VAR
      TheId: Ident;
      TheQualIdent: QualIdent;
      TheSet: ClassActualSet;
      TheClassValue: ClassDeclaration;
      TheFormal: ClassFormal;

    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      IF TheId <> VOID THEN
        RESULT.CREATE (2);
        RESULT[1] := TheId;
       ELSE
        RESULT.CREATE (1);
        END;
      RESULT[0] := TheQualIdent;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheQualIdent := Lkh.AcceptQualIdent;
      SetSon (TheQualIdent);
      IF Lkh.CurrentToken = Lkh.Becomes THEN
        TheId := TheQualIdent.FirstIdent;
        IF TheId <> TheQualIdent.LastIdent THEN
          Error ("Syntax error ");
          END;
        Lkh.GetToken;
        TheQualIdent := Lkh.AcceptQualIdent;
        SetSon (TheQualIdent);
        END;
      END Parse;

    METHOD Id: Ident;
      BEGIN
      RESULT:= TheId;
      END Id;

    METHOD QualId: QualIdent;
      BEGIN
      RESULT:= TheQualIdent;
      END QualId;

    REDEFINE METHOD Tag;
      BEGIN
      TheQualIdent.UniqueTag;
      TheClassValue := TheQualIdent.GetRef;
      END Tag;

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

    METHOD Match (Other: ClassActual): BOOLEAN;
      BEGIN
      IF NOT (Id = VOID IFF Other.Id = VOID) THEN
        RESULT := FALSE;
       ELSIF (Id <> VOID) AND
             (Id.Data <> Other.Id.Data) THEN
        RESULT := FALSE;
       ELSE
        -- check the QualIdent of the Actual.
        RESULT := Class.Match (Other.Class);
        END;
      END Match;
      
    METHOD SetClass (Class: ClassDeclaration);
      BEGIN   
      TheClassValue := Class;
      END SetClass;

    METHOD Class: ClassDeclaration;
      BEGIN
      RESULT := TheClassValue;
      END Class;

    REDEFINE METHOD CREATE(Set: ClassActualSet;
                           LineNr, ColNr: INTEGER);
      BEGIN
      TheSet := Set;
      BASE(LineNr, ColNr);
      END CREATE; 
      
    METHOD Set: ClassActualSet;
      BEGIN
      RESULT := TheSet;
      END Set;
      
    METHOD Enter;
      BEGIN
      ASSERT TheFormal <> VOID;
      ASSERT TheClassValue <> VOID;
      SymbolTable.Enter (TheFormal.Id.Data, TheClassValue);
      END Enter;
      
    METHOD SetFormal (Formal: ClassFormal);
      BEGIN
      TheFormal := Formal;
      END SetFormal;
      
    METHOD Formal: ClassFormal;
      BEGIN
      RESULT := TheFormal;
      END Formal;
      
  END ClassActual;
----------------------------------------
  CLASS ClassFormalSet;
    INHERITS NonTerminal(DummyNTCodeGenerator);
    
    VAR
      TheFormalList: NTList(ClassFormal);
      TheClass: ClassDeclaration;
    
    REDEFINE METHOD CREATE (LineNr, ColNr: INTEGER);
      BEGIN
      BASE(LineNr, ColNr);
      TheFormalList.CREATE;
      END CREATE;
      
    METHOD Class: ClassDeclaration;
      VAR
        r: ONCE Ref(ClassDeclaration);
      BEGIN
      IF TheClass = VOID THEN
        IF r = VOID THEN
          r.CREATE (VOID);
          END;
        r.Set(VOID);
        GetAncestor(r);
        TheClass := r.Get;
        ASSERT TheClass.Canonic = TheClass;
        END;
      RESULT := TheClass;
      r.Set(VOID);
      END Class;
      
    -----------------------------------------
    -- Calls MatchClassActual repeatedly for the first formal
    -- and the attached successors.
    -----------------------------------------
    METHOD MatchClassActuals (Act: ClassActualSet): BOOLEAN;
      VAR
        ActList: NTList(ClassActual);
        BEGIN
      IF Act <> VOID THEN
        ActList := Act.ActualList;
        IF TheFormalList.Size = ActList.Size THEN
          RESULT := TRUE;
          FOR i := 0 TO TheFormalList.Size - 1 WHILE RESULT DO
            RESULT := TheFormalList.Get(i).MatchClassActual (ActList.Get(i));
            END;
         ELSE
          Act.Error ("Parameterized class arity error");
          END;
        END;
      END MatchClassActuals;
      
    METHOD Match (Other: ClassFormalSet): BOOLEAN;
      BEGIN
      IF Other <> VOID THEN
        IF Other.TheFormalList.Size = TheFormalList.Size THEN
          RESULT := TRUE;
          FOR i := 0 TO TheFormalList.Size - 1 WHILE RESULT DO
            RESULT := TheFormalList.Get(i).MatchClassFormal 
                                        (Other.TheFormalList.Get(i));
            END;
          END;
        END;
      END Match;
      
    REDEFINE METHOD Parse(Lkh: LookAhead);
      VAR
        ClForm: ClassFormal;
      BEGIN
      Lkh.Accept (Lkh.LeftParen);
      ClForm.CREATE (THIS, Lkh.LineNr, Lkh.ColNr);
      ClForm.Parse (Lkh);
      TheFormalList.Append (ClForm);
      WHILE (Lkh.CurrentToken <> Lkh.RightParen) AND (Lkh.Ok) DO
        Lkh.Accept (Lkh.Comma);
        ClForm.CREATE (THIS, Lkh.LineNr, Lkh.ColNr);
        ClForm.Parse (Lkh);
        TheFormalList.Append (ClForm);
        END;
      Lkh.Accept (Lkh.RightParen);
      END Parse;
      
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "ClassFormalSet";
      END WhatAmI;
      
    REDEFINE METHOD Tag;
      BEGIN
      VOID := Class;
      TheFormalList.UniqueTag;
      END Tag;
      
    METHOD FormalList: NTList(ClassFormal);
      BEGIN
      RESULT := TheFormalList;
      END FormalList;
      
    METHOD Size: INTEGER;
      BEGIN
      RESULT := TheFormalList.Size;
      END Size;
      
    METHOD ToVirtualActualSet: ClassActualSet;
      BEGIN
      ASSERT Class <> VOID;
      IF Class.Canonic <> Class THEN
        RESULT := Class.Canonic.ClassFormals.ToVirtualActualSet;
       ELSE
        RESULT.CREATE (LineNr, ColNr);
        FOR f IN FormalList DO
          RESULT.ActualList.Append (f.ToVirtualActual(RESULT));
          END;
        END;
      END ToVirtualActualSet;
      
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT := FormalList.SubTree;
      END SubTree;
      
  END ClassFormalSet;
----------------------------------------
  CLASS ClassFormal;
    INHERITS ClassDeclaration(MethodDeclaration,
                              CompilationUnit,
                              DummyClDeclCodeGenerator);

    VAR
      TheIdent: Ident;
      TheLimitingId: QualIdent;
      TheLimitingClass: ClassDeclaration;
      TheSet: ClassFormalSet;
      
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE (2);
      RESULT[0] := TheIdent;
      RESULT[1] := TheLimitingId;
      END SubTree;
      
    REDEFINE METHOD CREATE(Set: ClassFormalSet;
                           LineNr, ColNr: INTEGER);
      BEGIN
      ASSERT Set <> VOID;
      TheSet := Set;
      SetFather (Set);
      BASE (LineNr, ColNr);
      END CREATE;
      
    METHOD Set: ClassFormalSet;
      BEGIN
      RESULT := TheSet;
      END Set;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheIdent := Lkh.AcceptIdent;
      SetSon (TheIdent);
      IF Lkh.CurrentToken = Lkh.In THEN
        Lkh.GetToken;
        TheLimitingId := Lkh.AcceptQualIdent;
        SetSon (TheLimitingId);
        END;
      END Parse;

    REDEFINE METHOD Id: Ident;
      BEGIN
      RESULT := TheIdent;
      END Id;
                     
    ------------------------------------
    -- Searching for an identifier in a FormalClass
    -- happens by going through its attached limiting
    -- class.
    ------------------------------------
    REDEFINE METHOD GetDecl (IdSearched: ARRAY OF CHAR): Declaration;
      BEGIN
      IF TheLimitingClass <> VOID THEN
        RESULT := TheLimitingClass.GetDecl (IdSearched);
        END;
      END GetDecl;
      
    METHOD LimitingClass: ClassDeclaration;
      BEGIN
      RESULT := TheLimitingClass;
      END LimitingClass;

    REDEFINE METHOD Tag;
      BEGIN
      IF TheLimitingId <> VOID THEN
        TheLimitingId.UniqueTag;
        IF TheLimitingId.LastIdent.GetRef <> VOID THEN
          WHAT TheLimitingId.LastIdent.GetRef OF
            IN PredefClass:
              Error ("Cannot limit on a predefined class");
              END;
            IN ClassDeclaration:
              TheLimitingClass := TAG;
              END;
           ELSE
            Error ("Class declaration expected");
            END;
          END;        
        END;
      END Tag;

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

    METHOD MatchClassFormal (Other: ClassFormal): BOOLEAN;
      BEGIN
      RESULT := TRUE;
      IF Id.Data <> Other.Id.Data THEN
        Error('Non matching Class Formals: ' + Id.Data + '/' + Other.Id.Data);
        RESULT := FALSE;        
       ELSIF TheLimitingClass <> Other.TheLimitingClass THEN
        --------------------------
        -- Make sure one is not the implementation attached
        -- to the other...
        --------------------------
        IF (TheLimitingClass = VOID) OR NOT
           TheLimitingClass.Match (Other.TheLimitingClass) THEN
          Error ('Non matching limiting clauses');
          RESULT := FALSE;        
          END;
        END;
      END MatchClassFormal;

    METHOD MatchClassActual (Act: ClassActual): BOOLEAN;
      VAR
        b: ARRAY OF CHAR;
      BEGIN
      IF (Act.Id = VOID) OR (Act.Id.Data = Id.Data) THEN
        IF (TheLimitingClass = VOID) OR
            TheLimitingClass.Compatible(Act.Class) THEN
          RESULT := TRUE;
         ELSE
          ASSERT NOT TheLimitingClass.Compatible(Act.Class);
          DEBUG 
            IF Act.Class <> VOID THEN
              b := Act.Class.WhatAmI;
             ELSE
              b := "<Dead type>";
              END;
            Act.Error ("Lim: " + TheLimitingClass.WhatAmI + "/" + b);
            END;
          Act.Error ("Limited constraint failure");
          END;
       ELSE
        Act.Error ("Non matching class parameter name");
        END;
      END MatchClassActual;
    
    METHOD ToVirtualActual(Set: ClassActualSet): ClassActual;
      VAR
        VirtualCl: VirtualClassDecl;
      BEGIN
      RESULT.CREATE (Set, LineNr, ColNr);
      VirtualCl.CREATE (RESULT);
      RESULT.SetClass (VirtualCl);
      RESULT.SetFormal (THIS);
      END ToVirtualActual;
      
  END ClassFormal;
  
END YaflParamClasses;

