----------------------------------------------------------------------------- -- |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 ]