----------------------------------------------------------------------------- -- |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" }