packages feed

helium-1.8: src/Helium/StaticAnalysis/Inferencers/GlobalInfo.ag

-----------------------------------------------------------------------------
-- |The Helium Compiler : Static Analysis
-- 
-- Maintainer  :  bastiaan@cs.uu.nl
-- Stability   :  experimental
-- Portability :  unknown
--
-- Make a doubly-linked tree from the local information that is    
-- available.  
--
---------------------------------------------------------------------------------------

---------------------------------------------------------------------------------------
-- Right-hand side

SEM RightHandSide [ parentTree : InfoTree | | infoTree : InfoTree ]     
  | Expression  
       loc . parentTree = node @lhs.parentTree @localInfo (@expression.infoTree : @where.infoTrees)
       lhs . infoTree   = @parentTree
  | Guarded     
       loc . parentTree = node @lhs.parentTree @localInfo (@guardedexpressions.infoTrees ++ @where.infoTrees)
       lhs . infoTree   = @parentTree

---------------------------------------------------------------------------------------
-- Expression

SEM Expression [ parentTree : InfoTree | | infoTree : InfoTree ]
  | Literal      
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree
  | Variable     
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree
  | Hole
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree
  | Constructor  
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree
  | NormalApplication  
       loc . parentTree = node @lhs.parentTree @localInfo (@function.infoTree : @arguments.infoTrees)
       lhs . infoTree   = @parentTree                  
  | InfixApplication   
       loc . parentTree = node @lhs.parentTree @localInfo 
                            (@leftExpression.infoTrees ++ [@operator.infoTree] ++ @rightExpression.infoTrees)
       lhs . infoTree   = @parentTree                                                               
  | If           
       loc . parentTree = node @lhs.parentTree @localInfo [@guardExpression.infoTree, @thenExpression.infoTree, @elseExpression.infoTree]
       lhs . infoTree   = @parentTree                  
  | Lambda       
       loc . parentTree = node @lhs.parentTree @localInfo (@patterns.infoTrees ++ [@expression.infoTree])
       lhs . infoTree   = @parentTree   
  | Case         
       loc . parentTree = node @lhs.parentTree @localInfo (@expression.infoTree : @alternatives.infoTrees)
       lhs . infoTree   = @parentTree   
  | Let          
       loc . thisTree   = node @lhs.parentTree @localInfo [@declTree, @expression.infoTree]
           . declTree   = node @thisTree @declInfo @declarations.infoTrees
       lhs . infoTree   = @thisTree             
       expression   . parentTree = @thisTree
       declarations . parentTree = @declTree  
  | Do           
       loc . parentTree = node @lhs.parentTree @localInfo @statements.infoTrees
       lhs . infoTree   = @parentTree     
  | List         
       loc . parentTree = node @lhs.parentTree @localInfo (@expressions.infoTrees)
       lhs . infoTree   = @parentTree    
  | Tuple        
       loc . parentTree = node @lhs.parentTree @localInfo (@expressions.infoTrees)
       lhs . infoTree   = @parentTree 
  | Comprehension   
       loc . parentTree = node @lhs.parentTree @localInfo @qualifiers.infoTrees
       lhs . infoTree   = @parentTree     
  | Typed        
       loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree]
       lhs . infoTree   = @parentTree 
  | Enum         
       loc . parentTree = node @lhs.parentTree @localInfo (@from.infoTree : @then.infoTrees ++ @to.infoTrees)
       lhs . infoTree   = @parentTree 
  | Negate       
       loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree]
       lhs . infoTree   = @parentTree 
  | NegateFloat  
       loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree]
       lhs . infoTree   = @parentTree 

---------------------------------------------------------------------------------------
-- Pattern

SEM Pattern [ parentTree : InfoTree | | infoTree : InfoTree ]
  | Literal      
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree 
  | Variable     
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree 
  | Hole
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree 
  | Constructor  
       loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees
       lhs . infoTree   = @parentTree 
  | InfixConstructor   
       loc . parentTree = node @lhs.parentTree @localInfo [@leftPattern.infoTree, @rightPattern.infoTree]
       lhs . infoTree   = @parentTree 
  | List         
       loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees
       lhs . infoTree   = @parentTree 
  | Tuple        
       loc . parentTree = node @lhs.parentTree @localInfo @patterns.infoTrees
       lhs . infoTree   = @parentTree 
  | Negate       
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree 
  | As           
       loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree]
       lhs . infoTree   = @parentTree 
  | Wildcard     
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree 
  | NegateFloat  
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree

---------------------------------------------------------------------------------------
-- Statement

SEM Statement [ parentTree : InfoTree | | infoTree : InfoTree ]
  | Expression   
       loc . parentTree = node @lhs.parentTree @localInfo [@expression.infoTree]
       lhs . infoTree   = @parentTree  
  | Let          
       loc . thisTree   = node @lhs.parentTree @localInfo [@declTree]
           . declTree   = node @thisTree @declInfo @declarations.infoTrees
       lhs . infoTree   = @thisTree            
       declarations . parentTree = @declTree
                                                                                       
  | Generator    
       loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @expression.infoTree]
       lhs . infoTree   = @parentTree  
  | Empty        
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree

---------------------------------------------------------------------------------------
-- Qualifier

SEM Qualifier [ parentTree : InfoTree | | infoTree : InfoTree ]
  | Guard        
       loc . parentTree = node @lhs.parentTree @localInfo [@guard.infoTree]
       lhs . infoTree   = @parentTree  
  | Let         
       loc . thisTree = node @lhs.parentTree @localInfo [@declTree]
           . declTree = node @thisTree @declInfo @declarations.infoTrees
       lhs . infoTree = @thisTree                     
       declarations . parentTree = @declTree                 
  | Generator    
       loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @expression.infoTree]
       lhs . infoTree   = @parentTree  
  | Empty        
       loc . parentTree = node @lhs.parentTree @localInfo []
       lhs . infoTree   = @parentTree   
                 
---------------------------------------------------------------------------------------
-- Combining sub-trees without introducing a new node

SEM Body [ | | infoTree : InfoTree ]
  | Hole         lhs . infoTree = root (LocalInfo {self = UHA_Decls [], assignedType = Nothing, monos = []}) []
  | Body         loc . parentTree = root @declInfo @declarations.infoTrees
                 lhs . infoTree   = @parentTree

SEM Expressions [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTree : @tl.infoTrees
  | Nil    lhs . infoTrees = []

SEM MaybeExpression [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Just     lhs . infoTrees = [@expression.infoTree]
  | Nothing  lhs . infoTrees = []

SEM Patterns [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTree : @tl.infoTrees
  | Nil    lhs . infoTrees = []     
    
SEM Alternatives [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees
  | Nil    lhs . infoTrees = []

SEM Alternative [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Hole          lhs . infoTrees = []
  | Alternative   lhs . infoTrees = [@pattern.infoTree, @righthandside.infoTree]  
  | Empty         lhs . infoTrees = []

SEM Statements [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTree : @tl.infoTrees
  | Nil    lhs . infoTrees = []
         
SEM Qualifiers [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTree : @tl.infoTrees
  | Nil    lhs . infoTrees = []
              
SEM GuardedExpressions [ parentTree : InfoTree | | infoTrees : InfoTrees ]
   | Cons   lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees
   | Nil    lhs . infoTrees = []

SEM GuardedExpression [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | GuardedExpression   lhs . infoTrees = [@guard.infoTree, @expression.infoTree]

SEM MaybeDeclarations [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Nothing  lhs . infoTrees = []
  | Just     loc . theNode   = node @lhs.parentTree @declInfo @declarations.infoTrees
             lhs . infoTrees = [@theNode]
             declarations . parentTree = @theNode

SEM Declarations [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTrees ++ @tl.infoTrees
  | Nil    lhs . infoTrees = []
   
SEM Declaration [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Type     lhs . infoTrees = []
  | Data     lhs . infoTrees = []
  | Hole     lhs . infoTrees = []
  | FunctionBindings    loc . parentTree = node @lhs.parentTree @localInfo @bindings.infoTrees
                        lhs . infoTrees  = [@parentTree]
  | PatternBinding      loc . parentTree = node @lhs.parentTree @localInfo [@pattern.infoTree, @righthandside.infoTree]
                        lhs . infoTrees  = [@parentTree]
  | TypeSignature  lhs . infoTrees = []
  | Fixity         lhs . infoTrees = []
  | Empty          lhs . infoTrees = []
    
SEM FunctionBindings [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Cons   lhs . infoTrees = @hd.infoTree : @tl.infoTrees
  | Nil    lhs . infoTrees = []

SEM FunctionBinding [ parentTree : InfoTree | | infoTree : InfoTree ]
  | Hole             loc . parentTree = node @lhs.parentTree @localInfo []
                     lhs . infoTree   = @parentTree
  | FunctionBinding  loc . parentTree = node @lhs.parentTree @localInfo (@lefthandside.infoTrees ++ [@righthandside.infoTree])
                     lhs . infoTree   = @parentTree   
  
SEM LeftHandSide [ parentTree : InfoTree | | infoTrees : InfoTrees ]
  | Function       lhs . infoTrees = @patterns.infoTrees 
  | Infix          lhs . infoTrees = [@leftPattern.infoTree, @rightPattern.infoTree] 
  | Parenthesized  lhs . infoTrees = @lefthandside.infoTrees ++ @patterns.infoTrees
                                                   
---------------------------------------------------------------------------------------
-- Prevent ag-warnings

SEM RecordPatternBinding    | RecordPatternBinding     loc . parentTree = globalInfoError
SEM RecordExpressionBinding | RecordExpressionBinding  loc . parentTree = globalInfoError
SEM Pattern                 | Successor                loc . infoTree   = globalInfoError
                            | Record                   loc . infoTree   = globalInfoError
SEM Expression              | RecordConstruction       loc . infoTree   = globalInfoError
SEM Declaration             | Default                  loc . infoTrees  = globalInfoError
                            | Newtype                  loc . infoTrees  = globalInfoError

{
globalInfoError :: a
globalInfoError = internalError "GlobalInfo.ag" "n/a" "global info not available"
}