helium-1.8: src/Helium/StaticAnalysis/Inferencers/TypeInferenceInfo.ag
-----------------------------------------------------------------------------
-- |The Helium Compiler : Static Analysis
--
-- Maintainer : bastiaan@cs.uu.nl
-- Stability : experimental
-- Portability : unknown
--
-- Additional information (a local attribute) is provided for each type constraint.
--
-------------------------------------------------------------------------------
---------------------------------------------------------------------------------------
-- Constraint Information : Body
SEM Body | Body loc . cinfo =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint, HasTrustFactor 10.0, IsImported name ]
---------------------------------------------------------------------------------------
-- Constraint Information : Declaration
SEM Declaration | FunctionBindings loc . cinfo =
resultConstraint "function bindings (INTERNAL ERROR)" @parentTree
[ FolkloreConstraint, highlyTrusted, FuntionBindingEdge @bindings.numberOfPatterns ]
SEM Declaration | PatternBinding loc . cinfo =
orphanConstraint 1 "right hand side" @parentTree
[]
---------------------------------------------------------------------------------------
-- Type Inferencing : FunctionBinding
SEM FunctionBinding | FunctionBinding loc . cinfoLeft =
\num ->
orphanConstraint num "pattern of function binding" @parentTree
[ Unifier (head (ftv (@lhs.betasLeft !! num))) (ordinal True (num+1)++" pattern of function bindings", attribute @lhs.parentTree, "pattern") ]
SEM FunctionBinding | FunctionBinding loc . cinfoBind =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint
, makeUnifier name "function binding" @lefthandside.environment @parentTree
]
---------------------------------------------------------------------------------------
-- Type Inferencing : RightHandSide
-- RightHandSide.Expression
SEM RightHandSide | Expression loc . cinfo =
orphanConstraint 0 "right-hand side" @parentTree
[ Unifier (head (ftv @lhs.betaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS @lhs.parentTree), "right-hand side") ]
---------------------------------------------------------------------------------------
-- Type Inferencing : Expression
-- Expression.Literal
SEM Expression | Literal loc . cinfo =
resultConstraint "literal" @parentTree
[ FolkloreConstraint, HasTrustFactor 10.0 ]
-- Expression.Constructor
SEM Expression | Constructor loc . cinfo =
resultConstraint "constructor" @parentTree
[ FolkloreConstraint, HasTrustFactor 10.0, IsImported @name.self ]
-- Expression.NormalApplication
SEM Expression | NormalApplication loc . cinfo =
childConstraint 0 "application" @parentTree
[ ApplicationEdge False (map attribute @arguments.infoTrees) ]
-- Expression.InfixApplication
SEM Expression | InfixApplication loc . operatorNr = length @leftExpression.infoTrees
loc . cinfoOperator =
childConstraint @operatorNr "infix application" @parentTree $
if @leftExpression.section || @rightExpression.section
then [ HasTrustFactor 10.0 ]
else [ ApplicationEdge True (map attribute (@leftExpression.infoTrees ++ @rightExpression.infoTrees)) ]
SEM Expression | InfixApplication loc . cinfoComplete =
specialConstraint "infix application (INTERNAL ERROR)" @parentTree
(self @localInfo, Nothing)
[ FolkloreConstraint, highlyTrusted ]
SEM Expression | InfixApplication loc . cinfoLeftSection =
specialConstraint "left section" @parentTree
(self @localInfo, Nothing)
[ ]
SEM Expression | InfixApplication loc . cinfoRightSection =
specialConstraint "right section" @parentTree
(self @localInfo, Nothing)
[ ]
SEM Expression | InfixApplication loc . cinfoEmpty =
specialConstraint "infix application" @parentTree
(self @localInfo, Nothing)
[ FolkloreConstraint, HasTrustFactor 10.0 ]
-- Expression.If
SEM Expression | If loc . cinfoGuard =
childConstraint 0 "conditional" @parentTree
[]
SEM Expression | If loc . cinfoThen =
childConstraint 1 "then branch of conditional" @parentTree
[ Unifier (head (ftv @beta)) ("conditional", @localInfo, "then branch") ]
SEM Expression | If loc . cinfoElse =
childConstraint 2 "else branch of conditional" @parentTree
[ Unifier (head (ftv @beta)) ("conditional", @localInfo, "else branch") ]
-- Expression.Lambda
SEM Expression | Lambda loc . cinfoBind =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint
, makeUnifier name "lambda abstraction" @patterns.environment @parentTree
]
SEM Expression | Lambda loc . cinfoType =
resultConstraint "lambda abstraction" @parentTree
[ FolkloreConstraint ]
-- Expression.Case
SEM Expression | Case loc . cinfo =
childConstraint 0 "scrutinee of case expression" @parentTree
[ Unifier (head (ftv @beta')) ("case patterns", @localInfo, "scrutinee") ]
-- Expression.Let
SEM Expression | Let loc . cinfoType =
resultConstraint "let expression (INTERNAL ERROR)" @thisTree
[ FolkloreConstraint, highlyTrusted ]
-- Expression.Do
SEM Expression | Do loc . cinfo =
resultConstraint "do-expression" @parentTree
[ FolkloreConstraint ]
-- Expression.List
SEM Expression | List loc . cinfoElem =
\elemNr ->
childConstraint elemNr "element of list" @parentTree $
[ HasTrustFactor 10.0 | length @expressions.betas < 2 ] ++
[ Unifier (head (ftv @beta')) ("list", @localInfo, ordinal False (elemNr+1) ++ " element") ]
SEM Expression | List loc . cinfoResult =
resultConstraint "list" @parentTree
[ FolkloreConstraint ]
-- Expression.Tuple
SEM Expression | Tuple loc . cinfo =
resultConstraint "tuple" @parentTree
[ FolkloreConstraint ]
-- Expression.Comprehension
SEM Expression | Comprehension loc . cinfo =
resultConstraint "list comprehension" @parentTree
[ FolkloreConstraint ]
-- Expression.Typed
SEM Expression | Typed loc . cinfoExpr =
childConstraint 0 "type annotation" @parentTree
[ TypeSignatureLocation (getTypeRange @type.self) ]
SEM Expression | Typed loc . cinfoResult =
resultConstraint "type annotation" @parentTree
[ FolkloreConstraint ] {- ??? -}
-- Expression.Enum
SEM Expression | Enum loc . cinfoFrom =
childConstraint 0 "enumeration" @parentTree
[]
SEM Expression | Enum loc . cinfoThen =
childConstraint 1 "enumeration" @parentTree
[]
SEM Expression | Enum loc . toChildNr = 1 + length @then.infoTrees
loc . cinfoTo =
childConstraint @toChildNr "enumeration" @parentTree
[]
SEM Expression | Enum loc . cinfoResult =
resultConstraint "enumeration" @parentTree
[ FolkloreConstraint ]
SEM Expression | Enum loc . cinfoPred =
resultConstraint "enumeration" @parentTree
[ ReductionErrorInfo (Predicate "Enum" @elementType) ]
-- Expression.Negate
SEM Expression | Negate loc . cinfo =
specialConstraint "negation" @parentTree
(self @localInfo, Just $ nameToUHA_Expr (Name_Operator @range.self [] "-"))
[]
SEM Expression | NegateFloat loc . cinfo =
specialConstraint "negation" @parentTree
(self @localInfo, Just $ nameToUHA_Expr (Name_Operator @range.self [] "-."))
[]
---------------------------------------------------------------------------------------
-- Type Inferencing : GuardedExpression
SEM GuardedExpression | GuardedExpression loc . cinfoGuard =
resultConstraint "guard" @guard.infoTree
[]
SEM GuardedExpression | GuardedExpression loc . cinfoExpr =
resultConstraint "guarded expression" @expression.infoTree $
[ HasTrustFactor 10.0 | @lhs.numberOfGuards < 2 ] ++
[ Unifier (head (ftv @lhs.betaRight)) ("right-hand sides", attribute (skip_UHA_FB_RHS @lhs.parentTree), "right-hand side") ]
---------------------------------------------------------------------------------------
-- Type Inferencing : Pattern
-- Pattern.Literal
SEM Pattern | Literal loc . cinfo =
resultConstraint "literal pattern" @parentTree
[ FolkloreConstraint, HasTrustFactor 10.0 ]
-- Pattern.Constructor
SEM Pattern | Constructor loc . cinfoConstructor =
resultConstraint "pattern constructor" @parentTree
[ FolkloreConstraint, HasTrustFactor 10.0 ]
SEM Pattern | Constructor loc . cinfoApply =
specialConstraint "pattern application" @parentTree
(self @localInfo, Just $ nameToUHA_Pat @name.self)
[ ApplicationEdge False (map attribute @patterns.infoTrees) ]
SEM Pattern | Constructor loc . cinfoEmpty =
resultConstraint "pattern constructor" @parentTree
[ HasTrustFactor 10.0 ]
-- Pattern.InfixConstructor
SEM Pattern | InfixConstructor loc . cinfoConstructor =
variableConstraint "pattern constructor" (nameToUHA_Pat @constructorOperator.self)
[ FolkloreConstraint, HasTrustFactor 10.0 ]
SEM Pattern | InfixConstructor loc . cinfoApply =
specialConstraint "infix pattern application" @parentTree
(self @localInfo, Just $ nameToUHA_Pat @constructorOperator.self)
[ ApplicationEdge True (map attribute [@leftPattern.infoTree, @rightPattern.infoTree]) ]
-- Pattern.List
SEM Pattern | List loc . cinfoElem =
\elemNr ->
childConstraint elemNr "element of pattern list" @parentTree $
[ HasTrustFactor 10.0 | length @patterns.constraintslist < 2 ] ++
[ Unifier (head (ftv @beta')) ("pattern list", @localInfo, ordinal False (elemNr+1) ++ " element") ]
SEM Pattern | List loc . cinfoResult =
resultConstraint "pattern list" @parentTree
[ FolkloreConstraint ]
-- Pattern.Tuple
SEM Pattern | Tuple loc . cinfo =
resultConstraint "pattern tuple" @parentTree
[ FolkloreConstraint ]
-- Pattern.Negate
SEM Pattern | Negate loc . cinfo =
resultConstraint "pattern negation" @parentTree
[ FolkloreConstraint ]
-- Pattern.As
SEM Pattern | As loc . cinfo =
specialConstraint "as pattern" @parentTree
(self @localInfo, Just $ nameToUHA_Pat @name.self)
[]
-- Pattern.NegateFloat
SEM Pattern | NegateFloat loc . cinfo =
resultConstraint "pattern negation" @parentTree
[ FolkloreConstraint ]
---------------------------------------------------------------------------------------
-- Type Inferencing : Alternative
SEM Alternative | Alternative loc . cinfoLeft =
resultConstraint "case pattern" @pattern.infoTree
[ Unifier (head (ftv @lhs.betaLeft)) ("case patterns", attribute @lhs.parentTree, "case pattern") ]
SEM Alternative | Alternative loc . cinfoBind =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint
, makeUnifier name "case alternative" @pattern.environment @lhs.parentTree
]
---------------------------------------------------------------------------------------
-- Type Inferencing : Statement
SEM Statement | Expression loc . cinfo =
orphanConstraint 0 "generator" @parentTree
[]
SEM Statement | Generator loc . cinfoResult =
childConstraint 1 "generator" @parentTree
[]
SEM Statement | Generator loc . cinfoBind =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint
, makeUnifier name "generator" @pattern.environment @parentTree
]
---------------------------------------------------------------------------------------
-- Type Inferencing : Qualifier
SEM Qualifier | Guard loc . cinfo =
orphanConstraint 0 "boolean qualifier" @parentTree
[]
SEM Qualifier | Generator loc . cinfoResult =
childConstraint 1 "generator" @parentTree
[]
SEM Qualifier | Generator loc . cinfoBind =
\name -> variableConstraint "variable" (nameToUHA_Expr name)
[ FolkloreConstraint
, makeUnifier name "generator" @pattern.environment @parentTree
]