IMPLEMENTATION MODULE YaflLoops;

IMPORT Ref;

FROM YaflCfg          IMPORT YaflCfg, CurrentSpot;
FROM YaflDeclarations IMPORT SingleDataItem;
FROM YaflLex          IMPORT LexicalAnalyzer;
FROM YaflLiteral      IMPORT IntegerLiteral;
FROM YaflPredefined   IMPORT PredefItems;
FROM YaflMethods      IMPORT MethodDeclaration;
FROM YaflMetImplementation IMPORT MethodImplementation;
FROM YaflMetDefinition IMPORT MethodDefinition;
FROM YaflParser       IMPORT LimitedWalker;
FROM YaflStatements   IMPORT StatementList, Assignment;
FROM YaflType         IMPORT Type;
FROM YaflSymbols      IMPORT SymbolTable;

---------------------------------------------------
  CLASS SpecialPattern;
  END SpecialPattern;
------------------------------------------------
  CLASS FillPattern;
    INHERITS SpecialPattern;

    VAR
      TheFromIndex, TheToIndex: TypedNonTerminal;
      TheLValue: Desig;
      TheValue: TypedNonTerminal;

    METHOD LValue: Desig;
      BEGIN
      RESULT := TheLValue;
      END LValue;

    METHOD FromIndex: TypedNonTerminal;
      BEGIN
      RESULT := TheFromIndex;
      END FromIndex;

    METHOD ToIndex: TypedNonTerminal;
      BEGIN
      RESULT := TheToIndex;
      END ToIndex;

    METHOD Value: TypedNonTerminal;
      BEGIN
      RESULT := TheValue;
      END Value;

    REDEFINE METHOD CREATE (LValue: Desig;
			    FromIndex, ToIndex: TypedNonTerminal;
			    Value: TypedNonTerminal);
      BEGIN
      BASE;
      TheLValue := LValue;
      TheFromIndex := FromIndex;
      TheToIndex := ToIndex;
      TheValue := Value;
      END CREATE;
      
  END FillPattern;
---------------------------------------------------
  CLASS LoopStatement;
    INHERITS CompoundStatement(LoopStatCodeGenerator);
    
    VAR
      TheSetSpec: SetSpecification;
      
      TheCond: TypedNonTerminal;
      TheStatementList: StatementList;
                     
    METHOD Statements: StatementList;
      BEGIN
      RESULT := TheStatementList;
      END Statements;

    METHOD FreeVariable: FreeVariableDataItem;
      BEGIN
      IF TheSetSpec <> VOID THEN
        RESULT := TheSetSpec.FreeVariable;
        END;
      END FreeVariable;
      
    METHOD SetSpec: SetSpecification;
      BEGIN
      RESULT := TheSetSpec;
      END SetSpec;  
      
    METHOD Cond: TypedNonTerminal;
      BEGIN
      RESULT := TheCond;
      END Cond;   
                                  
    REDEFINE METHOD CallsMethod: BOOLEAN;
      BEGIN
      RESULT :=((TheSetSpec <> VOID) AND TheSetSpec.WithSideEffects) OR
                ((TheCond <> VOID) AND (TheCond.WithSideEffects))
             OR ((TheStatementList <> VOID) AND 
                 (TheStatementList.CallsMethod));
      END CallsMethod;
    
    REDEFINE METHOD SubTree: ARRAY OF NonTerminal;
      BEGIN
      RESULT.CREATE(3);
      RESULT[0] := TheSetSpec;
      RESULT[1] := TheCond;
      RESULT[2] := TheStatementList;
      END SubTree;
      
    REDEFINE METHOD Parse(Lkh: LookAhead);
      
        METHOD AcceptWhileHeader;
          BEGIN
          Lkh.Accept (LexicalAnalyzer.While);
          TheCond := Lkh.AcceptPlainExpr;
          SetSon (TheCond);
          END AcceptWhileHeader;
      
      BEGIN
      IF Lkh.CurrentToken = LexicalAnalyzer.For THEN
        ----------------------------------------------------------
        -- It is a FOR Statement with an optional While condition.
        ----------------------------------------------------------
        Lkh.GetToken;
        TheSetSpec := Lkh.AcceptSetSpecification;
        SetSon (TheSetSpec);
        IF Lkh.CurrentToken = LexicalAnalyzer.While THEN
          -------------------------------------------
          -- The FOR loop includes a While condition.
          -------------------------------------------
          AcceptWhileHeader;
          END;  
       ELSE
        --------------------------------
        -- If it is not a FOR statement,  
        -- it must be a WHILE statement.
        --------------------------------
        AcceptWhileHeader;
        END;
      Lkh.Accept (LexicalAnalyzer.Do);
      TheStatementList := Lkh.AcceptStatementList;
      SetSon (TheStatementList);
      Lkh.Accept (LexicalAnalyzer.End); 
      END Parse;
      
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "LoopStatement";
      END WhatAmI;
  
    REDEFINE METHOD Tag;
      BEGIN
      IF TheSetSpec <> VOID THEN
        TheSetSpec.UniqueTag;
        IF TheSetSpec.CheckForPossibleConflicts <> VOID THEN
          TheSetSpec.FreeVariable.Id.Warning ("Possible conflicts with local declaration");
          END;
        SymbolTable.PushLevel;  
        TheSetSpec.EnterFreeVariable;
        END;
      IF TheCond <> VOID THEN
        TheCond.UniqueTag;
        END;    
      IF TheStatementList <> VOID THEN
        TheStatementList.UniqueTag;
        END;    
      IF TheSetSpec <> VOID THEN
        SymbolTable.PopLevel;
        END;
      END Tag;
        
    REDEFINE METHOD CheckType;
      VAR
        TheCondType: Type;
      BEGIN
      IF TheSetSpec <> VOID THEN
        TheSetSpec.UniqueCheckType;
        END;
      ------------------------------------------------
      -- Check the type of the attached statement list
      ------------------------------------------------
      IF TheStatementList <> VOID THEN
        TheStatementList.UniqueCheckType;
        END;  
      IF TheCond <> VOID THEN
        -----------------------------------
        -- Check the type of the condition.
        -----------------------------------    
        TheCondType := TheCond.GetType;
        IF (TheCondType = VOID) OR
           (TheCondType.SimpleType <> PredefItems.Boolean) OR
           (TheCondType.ArrayLevel <> 0) THEN
          Error ("Non boolean condition");
          END;
        END;
      END CheckType;
      
    METHOD ShouldRestoreValueStack: BOOLEAN;
      BEGIN
      IF TheStatementList <> VOID THEN
        RESULT := TheStatementList.UsesValueStack;
        END;
      IF NOT RESULT AND (TheCond <> VOID) THEN
        RESULT := TheCond.UsesValueStack;
        END;
      IF NOT RESULT AND (TheSetSpec <> VOID) THEN
        RESULT := TheSetSpec.UsesValueStack;
        END;
      END ShouldRestoreValueStack;
    
    REDEFINE METHOD UsesValueStack: BOOLEAN;
     BEGIN
     IF TheSetSpec <> VOID THEN
       RESULT := TheSetSpec.UsesValueStack;
       END;
     END UsesValueStack;

   METHOD CheckForPossibleConflicts: Declaration;
     BEGIN
     IF TheSetSpec <> VOID THEN
       RESULT := TheSetSpec.CheckForPossibleConflicts;
       END;
     END CheckForPossibleConflicts;

     
   REDEFINE METHOD CyclomaticComplexity: INTEGER;
     BEGIN
     IF TheStatementList <> VOID THEN
       RESULT := 1 + TheStatementList.CyclomaticComplexity;
      ELSE
       RESULT := 1;
       END;
     END CyclomaticComplexity;

  VAR
    PatternsAsked: BOOLEAN;
    ThePattern: SpecialPattern;

    METHOD Pattern: SpecialPattern;
      BEGIN
      IF NOT PatternsAsked THEN
        PatternsAsked := TRUE;
        ThePattern := CheckFillPattern;
        END;
      RESULT := ThePattern;
      END Pattern;

    METHOD CheckFillPattern: FillPattern;
      VAR
        TheLeft: Desig;
        TheRight: TypedNonTerminal;

        METHOD IsAcceptableTarget (Target: Desig): BOOLEAN;
          VAR
            LastEl: DesigElement;
	        TheLastExpr: TypedNonTerminal;
          BEGIN
          LastEl := Target.Last;
	      IF (LastEl.BrExpr <> VOID) AND (LastEl.BrExpr.Size = 1) THEN
            TheLastExpr := LastEl.BrExpr.Get(0);
            WHAT TheLastExpr OF
 	          IN Desig:
		        IF TAG.Elements.Size = 1 THEN
		          RESULT := TAG.First.Id.GetRef = FreeVariable;
		          END;
 		        END;
             ELSE
              END;
	        END;
 	      END IsAcceptableTarget;

      METHOD IsAcceptableExpression (Expr: TypedNonTerminal): BOOLEAN;
	    VAR
	      Walk: LimitedWalker (Ident);
	      Id: Ident;
        BEGIN
        RESULT := TRUE;
	    IF Expr.GetFolded = VOID THEN
          Walk.CREATE (Expr);
	      Id := Walk.Next;
	      WHILE (Id <> VOID) AND RESULT DO
	        RESULT := Id.GetRef <> FreeVariable;
  	        Id := Walk.Next;
	        END;
          END;
 	    END IsAcceptableExpression;

      METHOD CheckByClause: BOOLEAN;
        VAR
          ByClause: TypedNonTerminal;
  	    BEGIN
  	    RESULT := TRUE;
        IF TheSetSpec <> VOID THEN
          ByClause := TheSetSpec.ByExpression;
          END;
	    IF ByClause <> VOID THEN
	      RESULT := FALSE;
	      IF ByClause.GetFolded <> VOID THEN
            WHAT ByClause.GetFolded OF
	          IN IntegerLiteral:
	  	        RESULT := TAG.Value = 1;
	  	        END;
	  	      END;
	        END;
	      END;
	    END CheckByClause;

      BEGIN
      IF (TheStatementList <> VOID) AND (TheStatementList.Size = 1) AND 
         (Cond = VOID) AND (TheSetSpec.Filters = VOID) AND
         CheckByClause THEN
        WHAT TheStatementList.GetList.Get(0) OF
          IN Assignment:
 	        TheLeft := TAG.LeftExpr;
 	        TheRight := TAG.RightExpr;
            IF NOT TheLeft.WithSideEffects AND 
               NOT TheRight.WithSideEffects THEN
	          IF IsAcceptableTarget(TheLeft) AND
		             IsAcceptableExpression(TheRight) THEN
                RESULT.CREATE (TheLeft, 
                          TheSetSpec.FirstRefExpression, 
                          TheSetSpec.SecondRefExpression,
                               TheRight);
	            END;
	          END;
            END;
         ELSE
          END;
        END;
      END CheckFillPattern;
  
  END LoopStatement;

END YaflLoops;
