module Stan.Hie.MatchType
( hieMatchPatternType
) where
import Data.Array (Array)
import Stan.Core.List (checkWith)
import Stan.Ghc.Compat (IfaceTyCon (..), IfaceTyConInfo (..), PromotionFlag (NotPromoted))
import Stan.Hie.Compat (HieArgs (..), HieType (..), HieTypeFlat, TypeIndex, hFunTy2)
import Stan.NameMeta (compareNames)
import Stan.Pattern.Type (PatternType (..))
import qualified Data.Array as Arr
hieMatchPatternType
:: Array TypeIndex HieTypeFlat
-> PatternType
-> TypeIndex
-> Bool
hieMatchPatternType :: Array TypeIndex HieTypeFlat -> PatternType -> TypeIndex -> Bool
hieMatchPatternType Array TypeIndex HieTypeFlat
arr PatternType
pat TypeIndex
i = HieTypeFlat
curFlat HieTypeFlat -> PatternType -> Bool
`satisfyPattern` PatternType
pat
where
curFlat :: HieTypeFlat
curFlat :: HieTypeFlat
curFlat = Array TypeIndex HieTypeFlat
arr Array TypeIndex HieTypeFlat -> TypeIndex -> HieTypeFlat
forall i e. Ix i => Array i e -> i -> e
Arr.! TypeIndex
i
match :: PatternType -> TypeIndex -> Bool
match :: PatternType -> TypeIndex -> Bool
match = Array TypeIndex HieTypeFlat -> PatternType -> TypeIndex -> Bool
hieMatchPatternType Array TypeIndex HieTypeFlat
arr
satisfyPattern :: HieTypeFlat -> PatternType -> Bool
satisfyPattern :: HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
_ PatternType
PatternTypeAnything = Bool
True
satisfyPattern HieTypeFlat
t (PatternTypeNeg PatternType
p) =
Bool -> Bool
not (HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p)
satisfyPattern HieTypeFlat
t (PatternTypeOr PatternType
p1 PatternType
p2) =
HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
Bool -> Bool -> Bool
|| HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
satisfyPattern HieTypeFlat
t (PatternTypeAnd PatternType
p1 PatternType
p2) =
HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
Bool -> Bool -> Bool
&& HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
satisfyPattern (HTyVarTy Name
name) (PatternTypeName NameMeta
nameMeta []) =
NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
name
satisfyPattern
(HTyConApp IfaceTyCon{Name
IfaceTyConInfo
ifaceTyConName :: Name
ifaceTyConInfo :: IfaceTyConInfo
ifaceTyConName :: IfaceTyCon -> Name
ifaceTyConInfo :: IfaceTyCon -> IfaceTyConInfo
..} (HieArgs [(Bool, TypeIndex)]
hieArgs))
(PatternTypeName NameMeta
nameMeta [PatternType]
args)
=
IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
ifaceTyConInfo PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
NotPromoted
Bool -> Bool -> Bool
&& NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
ifaceTyConName
Bool -> Bool -> Bool
&& ((Bool, TypeIndex) -> PatternType -> Bool)
-> [(Bool, TypeIndex)] -> [PatternType] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
checkWith (\(Bool
_, TypeIndex
ix) PatternType
a -> PatternType -> TypeIndex -> Bool
match PatternType
a TypeIndex
ix) [(Bool, TypeIndex)]
hieArgs [PatternType]
args
satisfyPattern HieTypeFlat
t (PatternTypeFun PatternType
p1 PatternType
p2)
| Just (TypeIndex
i1, TypeIndex
i2) <- HieTypeFlat -> Maybe (TypeIndex, TypeIndex)
forall b. HieType b -> Maybe (b, b)
hFunTy2 HieTypeFlat
t =
PatternType -> TypeIndex -> Bool
match PatternType
p1 TypeIndex
i1
Bool -> Bool -> Bool
&& PatternType -> TypeIndex -> Bool
match PatternType
p2 TypeIndex
i2
satisfyPattern (HQualTy TypeIndex
_ TypeIndex
ix) PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
satisfyPattern (HForAllTy ((Name, TypeIndex), ForAllTyFlag)
_ TypeIndex
ix) PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
satisfyPattern HieTypeFlat
_flat PatternType
_p = Bool
False