diff options
Diffstat (limited to 'compiler/GHC/Iface/Ext/Utils.hs')
| -rw-r--r-- | compiler/GHC/Iface/Ext/Utils.hs | 29 |
1 files changed, 11 insertions, 18 deletions
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs index 20d047d150..5d4868b227 100644 --- a/compiler/GHC/Iface/Ext/Utils.hs +++ b/compiler/GHC/Iface/Ext/Utils.hs @@ -13,7 +13,6 @@ import GHC.Driver.Session ( DynFlags ) import GHC.Driver.Ppr import GHC.Data.FastString ( FastString, mkFastString ) import GHC.Iface.Type -import GHC.Core.Multiplicity import GHC.Types.Name hiding (varName) import GHC.Types.Name.Set import GHC.Utils.Outputable hiding ( (<>) ) @@ -59,7 +58,7 @@ generateReferencesMap = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty renderHieType :: DynFlags -> HieTypeFix -> String renderHieType dflags ht = showSDoc dflags (ppr $ hieTypeToIface ht) -resolveVisibility :: Type -> [Type] -> [(Bool,Type)] +resolveVisibility :: Type -> [Type] -> [(ArgFlag, Type)] resolveVisibility kind ty_args = go (mkEmptyTCvSubst in_scope) kind ty_args where @@ -69,18 +68,16 @@ resolveVisibility kind ty_args go env ty ts | Just ty' <- coreView ty = go env ty' ts - go env (ForAllTy (Bndr tv vis) res) (t:ts) - | isVisibleArgFlag vis = (True , t) : ts' - | otherwise = (False, t) : ts' + go env (ForAllTy (Bndr tv vis) res) (t:ts) = (vis , t) : ts' where ts' = go (extendTvSubst env tv t) res ts go env (FunTy { ft_res = res }) (t:ts) -- No type-class args in tycon apps - = (True,t) : (go env res ts) + = (Required, t) : (go env res ts) go env (TyVarTy tv) ts | Just ki <- lookupTyVar env tv = go env ki ts - go env kind (t:ts) = (True, t) : (go env kind ts) -- Ill-kinded + go env kind (t:ts) = (Required, t) : (go env kind ts) -- Ill-kinded foldType :: (HieType a -> a) -> HieTypeFix -> a foldType f (Roll t) = f $ fmap (foldType f) t @@ -158,21 +155,17 @@ hieTypeToIface = foldType go go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b) go (HLitTy l) = IfaceLitTy l - go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k) - in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t - go (HFunTy w a b) = IfaceFunTy VisArg w a b - go (HQualTy pred b) = IfaceFunTy InvisArg many_ty pred b + go (HForAllTy (Bndr (n, k) af) t) = + IfaceForAllTy (Bndr (IfaceTvBndr b) af) t + where b = (occNameFS $ getOccName n, k) + go (HFunTy' isConstraint w a b) = IfaceFunTy isConstraint w a b go (HCastTy a) = a go HCoercionTy = IfaceTyVar "<coercion type>" go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) -- This isn't fully faithful - we can't produce the 'Inferred' case hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs - hieToIfaceArgs (HieArgs xs) = go' xs - where - go' [] = IA_Nil - go' ((True ,x):xs) = IA_Arg x Required $ go' xs - go' ((False,x):xs) = IA_Arg x Specified $ go' xs + hieToIfaceArgs = foldr (\(flag, x) rest -> IA_Arg x flag rest) IA_Nil . unHieArgs data HieTypeState = HTS @@ -235,13 +228,13 @@ getTypeIndex t go (ForAllTy (Bndr v a) t) = do k <- getTypeIndex (varType v) i <- getTypeIndex t - return $ HForAllTy ((varName v,k),a) i + return $ HForAllTy (Bndr (varName v, k) a) i go (FunTy { ft_af = af, ft_mult = w, ft_arg = a, ft_res = b }) = do ai <- getTypeIndex a bi <- getTypeIndex b wi <- getTypeIndex w return $ case af of - InvisArg -> case w of Many -> HQualTy ai bi; _ -> error "Unexpected non-unrestricted predicate" + InvisArg -> HQualTy wi ai bi VisArg -> HFunTy wi ai bi go (LitTy a) = return $ HLitTy $ toIfaceTyLit a go (CastTy t _) = do |