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)
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 arr :: Array TypeIndex HieTypeFlat
arr pat :: PatternType
pat i :: 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 _ PatternTypeAnything = Bool
True
satisfyPattern t :: HieTypeFlat
t (PatternTypeNeg p :: PatternType
p) =
Bool -> Bool
not (HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p)
satisfyPattern t :: HieTypeFlat
t (PatternTypeOr p1 :: PatternType
p1 p2 :: PatternType
p2) =
HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p1
Bool -> Bool -> Bool
|| HieTypeFlat -> PatternType -> Bool
satisfyPattern HieTypeFlat
t PatternType
p2
satisfyPattern t :: HieTypeFlat
t (PatternTypeAnd p1 :: PatternType
p1 p2 :: 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
name) (PatternTypeName nameMeta :: NameMeta
nameMeta []) =
NameMeta -> Name -> Bool
compareNames NameMeta
nameMeta Name
name
satisfyPattern
(HTyConApp IfaceTyCon{..} (HieArgs hieArgs :: [(Bool, TypeIndex)]
hieArgs))
(PatternTypeName nameMeta :: NameMeta
nameMeta args :: [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 (\(_, ix :: TypeIndex
ix) a :: PatternType
a -> PatternType -> TypeIndex -> Bool
match PatternType
a TypeIndex
ix) [(Bool, TypeIndex)]
hieArgs [PatternType]
args
satisfyPattern (HFunTy i1 :: TypeIndex
i1 i2 :: TypeIndex
i2) (PatternTypeFun p1 :: PatternType
p1 p2 :: PatternType
p2) =
PatternType -> TypeIndex -> Bool
match PatternType
p1 TypeIndex
i1
Bool -> Bool -> Bool
&& PatternType -> TypeIndex -> Bool
match PatternType
p2 TypeIndex
i2
satisfyPattern (HQualTy _ ix :: TypeIndex
ix) p :: PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
satisfyPattern (HForAllTy _ ix :: TypeIndex
ix) p :: PatternType
p = PatternType -> TypeIndex -> Bool
match PatternType
p TypeIndex
ix
satisfyPattern _flat :: HieTypeFlat
_flat _p :: PatternType
_p = Bool
False