IMPLEMENTATION MODULE YaflCase;

FROM YaflLex          IMPORT LexicalAnalyzer;
FROM YaflCfg          IMPORT YaflCfg, CurrentSpot;
FROM YaflLiteral      IMPORT DiscreteLiteral;
FROM YaflNTList       IMPORT NTList;
FROM YaflPredefined   IMPORT PredefItems;
FROM YaflStatements   IMPORT StatementList;
FROM YaflType         IMPORT Type;
FROM Streams          IMPORT StdOut;
FROM YaflGStatements  IMPORT CaseStatCodeGenerator;

IMPORT SYSTEM;

  CLASS RangeSet;
    VAR
      Data: ARRAY OF ARRAY OF INTEGER;
      UsedData: INTEGER;

    REDEFINE METHOD CREATE;
      BEGIN
      BASE;
      Data.CREATE (16);
      END CREATE;

    METHOD Check (From, To: INTEGER): BOOLEAN;
      VAR
        MergeIndex: INTEGER;
      BEGIN
      ASSERT From <= To;
      RESULT := TRUE;
      MergeIndex := -1;
      FOR i := 0 TO UsedData - 1 WHILE RESULT DO
        IF NOT (Data[i][0] > To) AND NOT (Data[i][1] < From) THEN
          RESULT := FALSE;
         ELSIF From = Data[i][1] + 1 THEN
          ASSERT MergeIndex < 0;
          MergeIndex := i;
          END;
        END;
      IF RESULT THEN
        IF MergeIndex >= 0 THEN
          Data[MergeIndex][1] := To;
         ELSE
          IF UsedData >= Data.SIZE THEN
            Data := Data + Data; 
            END;
          Data[UsedData].CREATE(2);
          Data[UsedData][0] := From;
          Data[UsedData][1] := To;
          UsedData := UsedData + 1;
          END;
        END;
      END Check;

    METHOD Dump;
      BEGIN
      StdOut.WriteString ("Used data:");
      StdOut.WriteInt (UsedData, 0);
      StdOut.WriteLn;
      END Dump;

  END RangeSet;
--------------------------
  CLASS CaseStatement;
    INHERITS CompoundStatement(CaseStatCodeGenerator);
    
    VAR
      TheExpr: TypedNonTerminal;
      CaseAltList: NTList(CaseAlt);
      TheElseAlt: StatementList;
                             
      
    METHOD CaseAlts: NTList(CaseAlt);  
      BEGIN
      RESULT := CaseAltList;
      END CaseAlts;
     
    METHOD ElseAlt: StatementList; 
      BEGIN
      RESULT := TheElseAlt;
      END ElseAlt;

       
    REDEFINE METHOD CallsMethod: BOOLEAN;
      BEGIN 
      ASSERT TheExpr <> VOID;
      RESULT := TheExpr.WithSideEffects;
      IF NOT RESULT AND (CaseAltList <> VOID) THEN
        FOR i := 0 TO CaseAltList.Size - 1 WHILE NOT RESULT DO
          RESULT := CaseAltList.Get(i).CallsMethod;
          END;
        END;
      IF NOT RESULT AND (TheElseAlt <> VOID) THEN
        RESULT := TheElseAlt.CallsMethod;        
        END;
      END CallsMethod;
                          
    -------------------------------
    -- The CheckConflicts method checks whether
    -- one or more CASE alternative have overlapping
    -- ranges.
    -------------------------------
    METHOD CheckConflicts;
      VAR
        RSet: RangeSet;
      BEGIN 
      RSet.CREATE;
      IF CaseAltList <> VOID THEN
        FOR i := 0 TO CaseAltList.Size - 1 DO
          CaseAltList.Get(i).CheckConflicts (RSet);
          END;
        END;
      END CheckConflicts;

    REDEFINE METHOD CheckType;
      VAR
        DiscType, Work: Type;
        ErrFound: BOOLEAN;
      BEGIN                 
      Work := TheExpr.GetType;
      IF Work <> VOID THEN
        IF PredefItems.IsDiscreteScalar (Work) THEN
          DiscType := Work;
         ELSIF (TheExpr.GetFolded <> VOID) AND
               Expr.GetType.Match (PredefItems.Char.MakeType(0)) THEN
          DiscType := TheExpr.GetType;
          ASSERT PredefItems.IsDiscreteScalar (DiscType);
          END;
        END;
      IF DiscType = VOID THEN
        Error ("The discriminant expression must be a discrete scalar");
       ELSE
        IF CaseAltList <> VOID THEN
          FOR i := 0 TO CaseAltList.Size - 1 DO
            IF NOT CaseAltList.Get(i).CheckCaseAltType (DiscType) THEN
              ErrFound := TRUE;
              END;
            END;
          IF NOT ErrFound THEN
            CheckConflicts;
            END;
          END;
        END;
      IF TheElseAlt <> VOID THEN
        TheElseAlt.UniqueCheckType;
        END;
      END CheckType;

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

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      Lkh.Accept (LexicalAnalyzer.Case);
      TheExpr := Lkh.AcceptPlainExpr;
      SetSon (TheExpr);
      Lkh.Accept (LexicalAnalyzer.Of);
      CaseAltList := Lkh.AcceptCaseAltList;
      IF CaseAltList <> VOID THEN
        CaseAltList.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 := "CaseStatement";
      END WhatAmI;

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

    REDEFINE METHOD UsesValueStack: BOOLEAN;
      BEGIN
      RESULT := TheExpr.UsesValueStack;
      IF NOT RESULT AND (CaseAltList <> VOID) THEN
        FOR i := 0 TO CaseAltList.Size - 1 WHILE NOT RESULT DO
          RESULT := CaseAltList.Get(i).UsesValueStack;
          END;
        END;
      RESULT := RESULT OR ((TheElseAlt <> VOID) 
                           AND TheElseAlt.UsesValueStack);
      END UsesValueStack;    
      
    REDEFINE METHOD CyclomaticComplexity: INTEGER;
      BEGIN
      IF (CaseAltList <> VOID) THEN
        FOR i := 0 TO CaseAltList.Size - 1 DO
          RESULT := RESULT + CaseAltList.Get(i).CyclomaticComplexity;
          END;
        END;
      IF TheElseAlt <> VOID THEN
        RESULT := RESULT + TheElseAlt.CyclomaticComplexity;
        END;
      END CyclomaticComplexity;

  END CaseStatement;
----------------------------------------
  CLASS CaseAlt;
    INHERITS NonTerminal(CaseAltCodeGenerator);
    
    VAR
      TheTags: NTList(CaseTag);
      TheStatementList: StatementList;
    
                 
    METHOD Tags: NTList(CaseTag);  
      BEGIN
      RESULT := TheTags;
      END Tags;
           
    METHOD Statements: StatementList;
      BEGIN
      RESULT := TheStatementList;
      END Statements;  
      
    METHOD CallsMethod: BOOLEAN;
      BEGIN
      RESULT := (TheStatementList <> VOID) AND
                (TheStatementList.CallsMethod);
      END CallsMethod;

    METHOD LiteralOnly: BOOLEAN;
      BEGIN
      RESULT := TRUE;
      FOR i := 0 TO TheTags.Size - 1 WHILE RESULT DO
        RESULT := TheTags.Get(i).UseLiteral;
        END;
      END LiteralOnly;

    METHOD NoLiteral: BOOLEAN;
      BEGIN
      RESULT := TRUE;
      FOR i := 0 TO TheTags.Size - 1 WHILE RESULT DO
        RESULT := NOT TheTags.Get(i).UseLiteral;
        END;
      END NoLiteral;

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

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheTags.CREATE;
      TheTags.Append (Lkh.AcceptCaseTag);
      WHILE Lkh.CurrentToken = LexicalAnalyzer.Comma DO
        Lkh.GetToken;                         -- Skip the Comma
        TheTags.Append (Lkh.AcceptCaseTag);
        END;
      TheTags.SetFather (THIS);
      Lkh.Accept (LexicalAnalyzer.Colon);
      TheStatementList := Lkh.AcceptStatementList;
      SetSon (TheStatementList);
      Lkh.Accept (LexicalAnalyzer.End);
      Lkh.Accept (LexicalAnalyzer.SemiColon);
      END Parse;

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

    REDEFINE METHOD Tag;
      BEGIN
      IF TheTags <> VOID THEN
        TheTags.UniqueTag;
        END;
      IF TheStatementList <> VOID THEN
        TheStatementList.UniqueTag;
        END;
      END Tag;

    METHOD CheckCaseAltType (TheType: Type): BOOLEAN;
      BEGIN
      RESULT := TRUE;
      IF TheTags <> VOID THEN
        FOR i := 0 TO TheTags.Size - 1 DO
          IF NOT TheTags.Get(i).CheckCaseTagType (TheType) THEN
            RESULT := FALSE;
            END;
          END;
        END;
      TheStatementList.UniqueCheckType;
      END CheckCaseAltType;
   
    ---------------------------------------
    -- Check the conformity of the ranges
    -- within a case alternative
    ---------------------------------------  
    METHOD CheckConflicts (RSet: RangeSet);
      VAR
        CTag: CaseTag;
      BEGIN
      FOR i := 0 TO TheTags.Size - 1 DO
        CTag := TheTags.Get(i);
        IF NOT RSet.Check(CTag.FirstValue, CTag.SecondValue) THEN
          CTag.Error("Duplicate CASE tag");
          END;
        END;
      END CheckConflicts;     
      
    METHOD UsesValueStack: BOOLEAN;
      BEGIN
      RESULT := (TheStatementList <> VOID) AND 
                TheStatementList.UsesValueStack;
      END UsesValueStack;
      
    METHOD CyclomaticComplexity: INTEGER;
      BEGIN
      IF TheStatementList <> VOID THEN
        RESULT := 1 + TheStatementList.CyclomaticComplexity;
       ELSE
        RESULT := 1;
        END;
      END CyclomaticComplexity;

  END CaseAlt;
-----------------------------------------
  CLASS CaseTag;
    INHERITS NonTerminal(CaseTagCodeGenerator);
    
    VAR
      TheFirstExpr: TypedNonTerminal;
      TheSecondExpr: TypedNonTerminal;
    
      
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      IF TheSecondExpr = VOID THEN
        RESULT.CREATE(1);
       ELSE
        RESULT.CREATE(2);
        RESULT[1] := TheSecondExpr;
        END;
      RESULT[0] := TheFirstExpr;
      END SubTree;

    REDEFINE METHOD Parse(Lkh: LookAhead);
      BEGIN
      TheFirstExpr := Lkh.AcceptPlainExpr;
      SetSon (TheFirstExpr);
      IF Lkh.CurrentToken = LexicalAnalyzer.To THEN
        Lkh.GetToken;
        TheSecondExpr := Lkh.AcceptPlainExpr;
        SetSon (TheSecondExpr);
        END;
      END Parse;

    METHOD FirstExpr: TypedNonTerminal;
      BEGIN
      RESULT:= TheFirstExpr;
      END FirstExpr;

    METHOD SecondExpr: TypedNonTerminal;
      BEGIN
      RESULT:= TheSecondExpr;
      END SecondExpr;

    METHOD FirstValue: INTEGER;
      BEGIN
      WHAT TheFirstExpr.GetFolded OF
        IN DiscreteLiteral:
          RESULT := TAG.Ordinal;
          END;
        END;
      END FirstValue;

    METHOD SecondValue: INTEGER;
      BEGIN
      IF TheSecondExpr = VOID THEN
        RESULT := FirstValue;
       ELSE
        WHAT TheSecondExpr.GetFolded OF
          IN DiscreteLiteral:
            RESULT := TAG.Ordinal;
            END;
          END;
        END;
      END SecondValue;

    METHOD UseLiteral: BOOLEAN;
      BEGIN
      ASSERT SecondValue >= FirstValue;
      RESULT := SecondValue - FirstValue <= YaflCfg.CaseLiteralLimit;
      END UseLiteral;

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

    REDEFINE METHOD Tag;
      BEGIN
      TheFirstExpr.UniqueTag;
      IF TheSecondExpr <> VOID THEN
        TheSecondExpr.UniqueTag;
        END;
      END Tag;   
      
    ------------------------------------------
    -- make sure that the case tag is of the right type,
    -- that the expressions are constant, and that it is
    -- not a negative range.
    ------------------------------------------
    METHOD CheckCaseTagType (TheType: Type): BOOLEAN;
      BEGIN
      IF (NOT TheFirstExpr.ExprMatch (TheType)) OR
         ((TheSecondExpr <> VOID) AND
          (NOT TheSecondExpr.ExprMatch(TheType))) THEN
        Error ("Type mismatch [CASE]");
       ELSIF (TheFirstExpr.GetFolded = VOID) OR
         ((TheSecondExpr <> VOID) AND (TheSecondExpr.GetFolded = VOID)) THEN
        Error ("Non-constant case tag");
       ELSIF (TheSecondExpr <> VOID) AND (FirstValue > SecondValue) THEN
        Error ("Negative range");
       ELSE
        RESULT := TRUE;
        END;
      SetUseChars(TheType.SimpleType = PredefItems.Char);
      END CheckCaseTagType;

    VAR
      TheUseChars: BOOLEAN;

    METHOD SetUseChars(Val: BOOLEAN);
      BEGIN
      TheUseChars := Val;
      END SetUseChars;

    METHOD UseChars: BOOLEAN;
      BEGIN
      RESULT := TheUseChars;
      END UseChars;

  END CaseTag;

END YaflCase;
