IMPLEMENTATION MODULE YaflType;

FROM Conversions IMPORT      IntConversions;
FROM List             IMPORT List;
IMPORT Ref;

FROM YaflClDefinition IMPORT ClassDefinition;
FROM YaflClasses IMPORT      ConstrainedClassDecl, ClassDeclaration,
                             VirtualClassDecl;
FROM YaflIdentifiers IMPORT  QualIdent, Ident;
FROM YaflLex IMPORT          LexicalAnalyzer;
FROM YaflPredefined IMPORT   PredefItems, PredefClass, VoidType;
FROM Streams IMPORT          StdOut;
FROM YaflDeclarations IMPORT SingleDataItem;
FROM YaflClImplementation IMPORT ClassImplementation;
FROM YaflCfg IMPORT CurrentSpot;
FROM YaflNTList IMPORT NTList;
FROM YaflParamClasses IMPORT ClassFormal, ClassActualSet, ClassActual;
FROM YaflMethods IMPORT MethodDeclaration;
FROM YaflParser IMPORT LimitedWalker;

  CLASS TypedNonTerminal(gc IN TypedNTCodeGenerator);
    INHERITS NonTerminal(gc);
    VAR
      TheType: Type;
      Asked: BOOLEAN;
      TheFolded: Literal;
      TheContext: INTEGER;
     
      
    REDEFINE METHOD CREATE (LineNr, ColNr, Context: INTEGER);
     BEGIN
     BASE(LineNr, ColNr);
     TheContext := Context;
     END CREATE;
                           
    METHOD GetContext: INTEGER;
      BEGIN
      RESULT := TheContext;
      END GetContext;
       
    METHOD GetType: Type;
      BEGIN
      IF NOT Asked THEN
        Asked := TRUE;
        TheType := BuildType;
        END;
      RESULT := TheType;
      END GetType;

    METHOD GetFolded: Literal;
      BEGIN
      IF (TheFolded = VOID) AND NOT Asked THEN
        VOID := GetType;
        END;
      RESULT := TheFolded;
      END GetFolded;

    METHOD SetFolded (Litt: Literal);
      BEGIN
      TheFolded := Litt;
      END SetFolded;

    METHOD ExprCompatible (TheType: Type): BOOLEAN;
      BEGIN
      RESULT := (TheType <> VOID) AND TheType.Compatible (GetType);
      END ExprCompatible;

    METHOD ExprCompareCompatible (TheType: Type): BOOLEAN;
      BEGIN
      IF TheType <> VOID THEN
        RESULT := ExprCompatible (TheType);
        IF NOT RESULT THEN
          RESULT := TheType.CompareCompatible (GetType);        
          END;
        END;
      END ExprCompareCompatible;

    METHOD ExprMatch (TheType: Type): BOOLEAN;
      BEGIN
      IF TheType <> VOID THEN
        RESULT := TheType.Match (GetType);
        END;
      END ExprMatch;

    METHOD Optimized: TypedNonTerminal;
      BEGIN
      IF GetFolded <> VOID THEN
        RESULT := GetFolded;
       ELSE
        RESULT := THIS;
        END;
      END Optimized;

    METHOD WithSideEffects: BOOLEAN;
      BEGIN
      -- By default, return FALSE, of course.
      END WithSideEffects;
      
    METHOD Isomorph (Other: TypedNonTerminal): BOOLEAN;
      BEGIN
      DEBUG
        StdOut.WriteLine ("Non redefined Isomorph method:" + WhatAmI);
        ASSERT FALSE;
        END;
      END Isomorph;
      
    METHOD GrabConcat: ARRAY OF TypedNonTerminal;
      BEGIN
      RESULT.CREATE (1);
      RESULT [0] := THIS;
      END GrabConcat;
      
    METHOD UsesValueStack: BOOLEAN;
      BEGIN
      DEBUG
        StdOut.WriteLine ("Uses value stack not redefined: " + WhatAmI);
        END;
      END UsesValueStack;
      
    METHOD RequiresTempSaving: BOOLEAN;
      BEGIN
      -- Implicit FALSE
      END RequiresTempSaving;
      
    METHOD StatementContext: Statement;
      VAR
        TheRef: ONCE Ref(Statement);
      BEGIN                         
      IF TheRef = VOID THEN
        TheRef.CREATE (VOID);
        END;
      GetAncestor(TheRef);
      RESULT := TheRef.Get;
      TheRef.Set (VOID);
      END StatementContext;

  END TypedNonTerminal;
-------------------------------------------------------
  CLASS Type(gc IN TypeCodeGenerator);
    INHERITS NonTerminal(gc);
    
    VAR
      TheArrayLevel: INTEGER;
      TheQualId: QualIdent;
      TheClassActuals: ClassActualSet;
      TheConstrainedClass: ConstrainedClassDecl;

    METHOD ConstrainedClass: ConstrainedClassDecl;
      BEGIN
      RESULT := TheConstrainedClass;
      END ConstrainedClass;

    METHOD IsConstrained: BOOLEAN;
      BEGIN
      RESULT := ConstrainedClass.IsConstrained;
      END IsConstrained;
      
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      IF TheClassActuals = VOID THEN
        RESULT.CREATE(1);
       ELSE
        RESULT.CREATE(2);
        RESULT[1] := TheClassActuals;
        END;
      RESULT[0] := TheQualId;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheArrayLevel := 0;
      WHILE Lkh.CurrentToken = LexicalAnalyzer.Array DO
        Lkh.GetToken;
        Lkh.Accept (LexicalAnalyzer.Of);
        TheArrayLevel := TheArrayLevel + 1;
        END;
      TheQualId := Lkh.AcceptQualIdent;
      SetSon (TheQualId);
      IF Lkh.CurrentToken = Lkh.LeftParen THEN
        TheClassActuals := Lkh.AcceptClassActuals;
        SetSon (TheClassActuals);
        END;
      END Parse;

    METHOD ArrayLevel: INTEGER;
      BEGIN
      RESULT:= TheArrayLevel;
      END ArrayLevel;

    METHOD SimpleType: ClassDeclaration;
      BEGIN
      IF TheConstrainedClass = VOID THEN
        Error ("Incomplete type [2]");
       ELSE
        RESULT := TheConstrainedClass.SimpleType;
        END;
      END SimpleType;

    METHOD Actuals: ClassActualSet;
      BEGIN
      IF TheConstrainedClass = VOID THEN
        Error ("Incomplete type [3]");
       ELSE
        RESULT := TheConstrainedClass.Actuals;
        END;
      END Actuals;

    METHOD Match (Other: Type): BOOLEAN;
      BEGIN
      IF (Other <> VOID) AND (TheConstrainedClass <> VOID) THEN
        RESULT := (TheArrayLevel = Other.TheArrayLevel) AND
                  (TheConstrainedClass.Match(Other.ConstrainedClass));
        END;                  
      END Match;

    METHOD Compatible(Other: Type): BOOLEAN;
      BEGIN     
      IF Other <> VOID THEN
        IF Other = VoidType THEN
          RESULT := Other.Compatible (THIS);
         ELSE
          IF TheArrayLevel = Other.TheArrayLevel THEN
            IF TheArrayLevel = 0 THEN
              ASSERT (ConstrainedClass <> VOID);
              ASSERT (Other.ConstrainedClass <> VOID);
              RESULT := ConstrainedClass.Compatible(Other.ConstrainedClass);
             ELSE
              RESULT := ConstrainedClass.Match(Other.ConstrainedClass);
              END;
            END;
          END;
        END;
      END Compatible;

    METHOD CompareCompatible(Other: Type): BOOLEAN;
      BEGIN     
      IF Other <> VOID THEN
        IF Other = VoidType THEN
          RESULT := Other.Compatible (THIS);
         ELSE
          IF TheArrayLevel = Other.TheArrayLevel THEN
            IF TheArrayLevel = 0 THEN
              ASSERT (ConstrainedClass <> VOID);
              ASSERT (Other.ConstrainedClass <> VOID);
              RESULT := ConstrainedClass.SimpleType.Compatible
                               (Other.ConstrainedClass.SimpleType);
             ELSE
              RESULT := ConstrainedClass.Match(Other.ConstrainedClass);
              END;
            END;
          END;
        END;
      END CompareCompatible;

    METHOD Set (ConstrainedClass: ConstrainedClassDecl;
                ALevel: INTEGER);
      BEGIN
      ASSERT ConstrainedClass <> VOID;
      TheArrayLevel := ALevel;
      TheConstrainedClass := ConstrainedClass;
      END Set;

    METHOD SetParamType (SimpleType: ClassDeclaration;
                         ALevel: INTEGER;
                         Actuals: ClassActualSet);
      BEGIN
      TheArrayLevel := ALevel;
      TheConstrainedClass.CREATE(SimpleType, Actuals);
      END SetParamType;

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

    REDEFINE METHOD Tag;
      VAR
        TheClass: ClassDeclaration;
      BEGIN
      TheQualId.UniqueTag;
      IF TheQualId.GetRef <> VOID THEN
        IF TheClassActuals <> VOID THEN
          TheClassActuals.UniqueTag;
          END;
        TheClass := TheQualId.GetRef;
        WHAT TheClass OF
          IN VirtualClassDecl:
            ------------------------------------------
            -- The SimpleType refers to a ClassFormal.
            -- No Actual parameters are allowed.
            ------------------------------------------
            IF TheClassActuals <> VOID THEN
              Error ("No actual parameters are allowed when referring to" +
                     " a formal class");
              END;
            SetParamType(TAG, ArrayLevel, VOID);  
            END;
         ELSE
          IF TheClass.ClassFormals <> VOID THEN
            IF TheClassActuals <> VOID THEN
              --------------------------------------------------
              -- If both formals (in the original class declaration)
              -- and actuals (in the type declaration) are specified,
              -- their conformity to each other must be ensured.
              --------------------------------------------------
              IF NOT TheClass.ClassFormals.MatchClassActuals 
                          (TheClassActuals) THEN
                Error ("Parameterized class mismatch");
               ELSE
                SetParamType (TheClass, ArrayLevel, TheClassActuals);
                END;
             ELSE
              ---------------------------------------------------
              -- If the parameters of a parametric class
              -- are not specified, we create Virtual parameters.
              ---------------------------------------------------
              SetParamType (TheClass, ArrayLevel, 
                            TheClass.ClassFormals.ToVirtualActualSet);
              ASSERT NOT IsConstrained;                              
              END;
           ELSIF TheClassActuals <> VOID THEN
            ------------------------------
            -- The class formal's list is VOID. Hence, the class
            -- is not parameterized.
            ------------------------------
            Error ("Unexpected parameter class");
           ELSE
            SetParamType (TheClass, ArrayLevel, VOID);
            END;  
          END;
        END;
      END Tag;

    METHOD MatchBrackets (BracketList: ExpressionList): Type;
      VAR
        BrSize: INTEGER;
      BEGIN
      IF BracketList <> VOID THEN
        IF BracketList.CheckAllIntegers THEN
          BrSize := BracketList.Size;
          IF TheArrayLevel >= BrSize THEN
            RESULT := SimpleType.Canonic.MakeConstrainedType 
                                     (TheArrayLevel - BrSize, Actuals);
           ELSE
            BracketList.Error ("Array nested too deep");
            END;
          END;
       ELSE
        RESULT := THIS;
        END;
      END MatchBrackets;

    METHOD Image: ARRAY OF CHAR;
      BEGIN
      RESULT := TheConstrainedClass.Image;
      IF TheArrayLevel > 0 THEN
        RESULT := RESULT + "[" + IntConversions.IntToString(TheArrayLevel, 0) +
                  "]";
        END;
      END Image;

    METHOD UseObjPtr: BOOLEAN;
      BEGIN
      IF TheArrayLevel > 0 THEN
        RESULT := TRUE;
       ELSE
        WHAT SimpleType OF
          IN PredefClass:
            RESULT := FALSE;
            END;
         ELSE
          RESULT := TRUE;
          END;
        END;
      END UseObjPtr;

    METHOD BuildContextual (Context: ConstrainedClassDecl): Type;
      VAR
        Constrained: ConstrainedClassDecl;
      BEGIN
      Constrained := TheConstrainedClass.BuildContextual(Context);
      IF Constrained <> TheConstrainedClass THEN
        IF Constrained <> VOID THEN
          RESULT := Constrained.MakeType(ArrayLevel);
          END;
       ELSE
        RESULT := THIS;
        END;
      END BuildContextual;
      
    METHOD QualId: QualIdent;
      BEGIN
      RESULT := TheQualId;
      END QualId;
      
    METHOD Removed: BOOLEAN;
      BEGIN       
      RESULT := (SimpleType <> VOID) AND SimpleType.Removed;
      END Removed;
      
  END Type;

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

  CLASS InstType;
    INHERITS Type(InstTypeCodeGenerator);
    
  END InstType;  
  
END YaflType;

