IMPLEMENTATION MODULE YaflWhat;

FROM List             IMPORT List;
IMPORT Ref;
FROM Streams          IMPORT StdOut;

FROM YaflCfg          IMPORT CurrentSpot, YaflCfg;
FROM YaflIdentifiers  IMPORT QualIdent;
FROM YaflLex          IMPORT LexicalAnalyzer;
FROM YaflMethods      IMPORT MethodDeclaration;
FROM YaflMetImplementation IMPORT MethodImplementation;
FROM YaflMetDefinition IMPORT MethodDefinition;
FROM YaflNTList       IMPORT NTList;
FROM YaflPredefined   IMPORT PredefClass;
FROM YaflStatements   IMPORT StatementList;
FROM YaflType         IMPORT Type;
FROM YaflClasses      IMPORT VirtualClassDecl, ClassDeclaration;
FROM YaflParamClasses IMPORT ClassFormal, ClassActual;
FROM YaflGStatements  IMPORT WhatStatCodeGenerator;
FROM YaflParamClasses IMPORT ClassActualSet;
  
  CLASS WhatStatement;
    INHERITS CompoundStatement(WhatStatCodeGenerator);
             
    VAR
      TheExpr: TypedNonTerminal;
      TheWhatAlts: NTList(WhatAlt);
      TheElseAlt: StatementList;

    METHOD WhatAlts: NTList(WhatAlt);   
      BEGIN
      RESULT := TheWhatAlts;
      END WhatAlts;
      
    METHOD ElseAlt: StatementList;
      BEGIN
      RESULT := TheElseAlt;
      END ElseAlt;
        
    REDEFINE METHOD CallsMethod: BOOLEAN;
      BEGIN         
      ASSERT TheExpr <> VOID;
      RESULT := TheExpr.WithSideEffects;
      IF NOT RESULT AND (TheWhatAlts <> VOID) THEN
        FOR i := 0 TO TheWhatAlts.Size - 1 WHILE NOT RESULT DO
          RESULT := TheWhatAlts.Get(i).CallsMethod;
          END;
        END;
      IF NOT RESULT AND (TheElseAlt <> VOID) THEN
        RESULT := TheElseAlt.CallsMethod;
        END;
      END CallsMethod;

    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE (2);
      RESULT[0] := TheExpr;
      RESULT[1] := TheElseAlt;
      IF TheWhatAlts <> VOID THEN
        RESULT := RESULT + TheWhatAlts.SubTree;
        END;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      Lkh.Accept (LexicalAnalyzer.What);
      TheExpr := Lkh.AcceptPlainExpr;
      SetSon (TheExpr);
      Lkh.Accept (LexicalAnalyzer.Of);
      TheWhatAlts := Lkh.AcceptWhatAltList;
      IF TheWhatAlts <> VOID THEN
        TheWhatAlts.SetFather (THIS);
        END;
      TheElseAlt := Lkh.AcceptElseAlt;
      SetSon (TheElseAlt);
      Lkh.Accept (LexicalAnalyzer.End);
      END Parse;

    METHOD Expr: TypedNonTerminal;
      BEGIN
      RESULT:= TheExpr;
      END Expr;

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

    REDEFINE METHOD Tag;
      BEGIN
      IF TheExpr <> VOID THEN
        TheExpr.UniqueTag;
        END;
      IF TheWhatAlts <> VOID THEN
        TheWhatAlts.UniqueTag;
        END;
      IF TheElseAlt <> VOID THEN
        TheElseAlt.UniqueTag;
        END;
      END Tag;

    REDEFINE METHOD CheckType;
      VAR
        GlobType: Type;
        ErrorFound: BOOLEAN;
        TheWhatAlt: WhatAlt;
      BEGIN
      GlobType := TheExpr.GetType;
      IF GlobType = VOID THEN
        Error("Expression has no type");
      ELSE
        -----------------------------------
        -- Make sure that the discriminant expression
        -- is a non-array object
        -----------------------------------
        IF GlobType.ArrayLevel > 0 THEN
          Error ("Array WHAT discriminant expression");
          ErrorFound := TRUE;
         ELSE
          WHAT GlobType.SimpleType OF
            IN PredefClass:
              Error ("Predefined type WHAT discriminant expression");
              ErrorFound := TRUE;
              END;
           ELSE
            ErrorFound := FALSE;
            END;
          END;
        IF TheWhatAlts <> VOID THEN
          FOR i := 0 TO TheWhatAlts.Size-1 DO
            TheWhatAlt := TheWhatAlts.Get(i);
            IF NOT ErrorFound THEN
              --------------------------
              -- First, make sure the alternative
              -- can be compared with the discriminant
              -- expression.
              --------------------------
              TheWhatAlt.CheckGuardType (GlobType);
              END;
            TheWhatAlt.UniqueCheckType;
            END;
          END;
        IF TheElseAlt <> VOID THEN
          TheElseAlt.UniqueCheckType;
          END;
        END;
      END CheckType;

    REDEFINE METHOD UsesValueStack: BOOLEAN;
      BEGIN
      RESULT := TRUE;
      END UsesValueStack;

    METHOD MarkRequiredClasses;
      BEGIN
      IF TheWhatAlts <> VOID THEN
        FOR i := 0 TO TheWhatAlts.Size - 1 DO
          TheWhatAlts.Get(i).MarkRequiredClasses;
          END;
        END;
      END MarkRequiredClasses;
      
    REDEFINE METHOD CyclomaticComplexity: INTEGER;
      BEGIN
      IF TheWhatAlts <> VOID THEN
        FOR i := 0 TO TheWhatAlts.Size - 1 DO
          RESULT := RESULT + TheWhatAlts.Get(i).CyclomaticComplexity;
          END;
        END;
      IF TheElseAlt <> VOID THEN
        RESULT := RESULT + TheElseAlt.CyclomaticComplexity;
        END;        
      END CyclomaticComplexity;

  END WhatStatement;

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

  CLASS WhatAlt;
    INHERITS NonTerminal(WhatAltCodeGenerator);
    
    VAR
      TheWhatTag: WhatTag;
      TheStatementList: StatementList;

    METHOD Statements: StatementList;
      BEGIN
      RESULT := TheStatementList;
      END Statements;

    METHOD MethodContext: MethodImplementation;
      VAR
        r: Ref(MethodImplementation);
      BEGIN
      r.CREATE (VOID);
      GetAncestor (r);
      RESULT := r.Get;
      END MethodContext;
      
    METHOD CallsMethod: BOOLEAN;
      BEGIN
      RESULT := (TheStatementList <> VOID) AND 
                TheStatementList.CallsMethod;
      END CallsMethod;

    METHOD CheckGuardType (DiscType: Type);
      BEGIN
      -------------------------------------------------------
      -- The discriminant is compatible with the alternative,
      -- or either one or both refer to a VirtualClassDecl.
      -------------------------------------------------------
      IF DiscType.Compatible (TheWhatTag.GetType) THEN
        IF (NOT TheWhatTag.Is) AND 
               TheWhatTag.GetType.Compatible (DiscType) THEN
          Warning ("Redundant WHAT alternative");
          END;
       ELSE
        ------------------------------
        -- Check the various error conditions
        ------------------------------
        WHAT TheWhatTag.GetType.SimpleType OF
          IN VirtualClassDecl:
            END;
         ELSE
          WHAT DiscType.SimpleType OF
            IN VirtualClassDecl:
              END;   
           ELSE
            Error ("Non compatible WHAT discriminant expression and Tag");
            END;
          END;   
        END;
      END CheckGuardType;


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

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheWhatTag.CREATE(Lkh.LineNr, Lkh.ColNr);
      TheWhatTag.Parse(Lkh);
      TheWhatTag.SetFather (THIS);
      Lkh.Accept (LexicalAnalyzer.Colon);
      TheStatementList := Lkh.AcceptStatementList;
      SetSon (TheStatementList);
      Lkh.Accept (LexicalAnalyzer.End);
      Lkh.Accept (LexicalAnalyzer.SemiColon);
      END Parse;

    METHOD WhatTagName: WhatTag;
      BEGIN
      RESULT:= TheWhatTag;
      END WhatTagName;

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

    VAR
      OldType: Type;
      EnclosingMeth: MethodImplementation;

    METHOD PushTagType;
      VAR
        TheType: Type;     
      BEGIN
      IF EnclosingMeth = VOID THEN
        EnclosingMeth := MethodContext;
        END;
      IF EnclosingMeth = VOID THEN
        Error ("WHAT cannot occur outside a method body");
       ELSE
        OldType := EnclosingMeth.TagDecl.GetType;
        TheType := TheWhatTag.GetType;
        IF TheType <> VOID THEN
          EnclosingMeth.TagDecl.SetType (TheType);
         ELSE
          DEBUG
            StdOut.WriteString ("TheType is VOID: ");
            StdOut.WriteInt (LineNr, 0);
            StdOut.WriteLn;
            END;
          END;
        END;
      END PushTagType;

    METHOD PopTagType;
      BEGIN
      IF EnclosingMeth <> VOID THEN
        EnclosingMeth.TagDecl.SetType (OldType);
        END;
      END PopTagType;

    REDEFINE METHOD Tag;
      BEGIN
      TheWhatTag.UniqueTag;
      PushTagType;
      IF TheStatementList <> VOID THEN
        TheStatementList.UniqueTag;
        END;
      PopTagType;
      END Tag;

    REDEFINE METHOD CheckType;
      BEGIN
      IF TheStatementList <> VOID THEN
        PushTagType;
        TheStatementList.UniqueCheckType;
        PopTagType;
        END;
      END CheckType;

    METHOD UsesValueStack: BOOLEAN;
      BEGIN
      IF TheStatementList <> VOID THEN
        RESULT := TheStatementList.UsesValueStack;
        END;
      END UsesValueStack;
      
    METHOD MarkRequiredClasses;
    
      METHOD MarkClass (Cl : ClassDeclaration);
        BEGIN
        WHAT Cl OF
          IN VirtualClassDecl:
            END;
         ELSE
          Cl.Reference.DoKeepDual;
          END;
        END MarkClass;
        
      VAR
        TheActuals : ClassActualSet;
        BEGIN                                    
      MarkClass(TheWhatTag.GetType.SimpleType);
      TheActuals := TheWhatTag.GetType.Actuals;
      IF TheActuals <> VOID THEN
        FOR i := 0 TO TheActuals.Size-1 DO        
          MarkClass(TheActuals.ActualList.Get(i).Class);
          END;
        END;
      END MarkRequiredClasses;                   
      
    METHOD CyclomaticComplexity: INTEGER;
      BEGIN
      RESULT := 1;
      IF TheStatementList <> VOID THEN
        RESULT := RESULT + TheStatementList.CyclomaticComplexity;
        END;
      END CyclomaticComplexity;

  END WhatAlt;

----------------------------------------
  CLASS WhatTag;
    INHERITS NonTerminal(WhatTagCodeGenerator);
    
    VAR
      WhatTagIS: BOOLEAN;
      TheType: Type;

    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE(1);
      RESULT[0] := TheType;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      IF Lkh.CurrentToken = LexicalAnalyzer.Is THEN
        WhatTagIS := TRUE;
        Lkh.GetToken;
       ELSE
        Lkh.Accept (LexicalAnalyzer.In);
        END;
      TheType := Lkh.AcceptType;
      SetSon (TheType);
      END Parse;

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

    REDEFINE METHOD Tag;
      BEGIN
      TheType.UniqueTag;
      IF TheType.ArrayLevel > 0 THEN
        Error("A WHAT cannot test arrays");
        END;
      END Tag;

    METHOD Is: BOOLEAN;
      BEGIN
      RESULT := WhatTagIS;
      END Is;

    METHOD Class: ClassDeclaration;
      BEGIN
      RESULT := TheType.SimpleType;
      END Class;

    METHOD GetType: Type;
      BEGIN
      RESULT := TheType;
      END GetType;
      
  END WhatTag;

END YaflWhat;
