diff options
author | Ben Gamari <ben@smart-cactus.org> | 2017-03-10 10:21:55 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-03-10 10:21:55 -0500 |
commit | db13d5f56d8e693b44bafc793d7b3bfac1c25b91 (patch) | |
tree | 128f2c23169c06c7a645979e37a1ba2cfda82c4b /haddock-api/src/Haddock/Interface | |
parent | 240bc38b94ed2d0af27333b23392d03eeb615e82 (diff) | |
parent | d2be5e88281d8e3148bc55830c27c75844b86f38 (diff) |
Merge branch 'ghc-head'
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r-- | haddock-api/src/Haddock/Interface/AttachInstances.hs | 13 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 56 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 58 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 21 |
4 files changed, 92 insertions, 56 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index f00da3ea..d5d74819 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -169,15 +169,15 @@ instHead (_, _, cls, args) = (map argCount args, className cls, map simplify args) argCount :: Type -> Int -argCount (AppTy t _) = argCount t + 1 +argCount (AppTy t _) = argCount t + 1 argCount (TyConApp _ ts) = length ts -argCount (ForAllTy (Anon _) _ ) = 2 -argCount (ForAllTy _ t) = argCount t -argCount (CastTy t _) = argCount t +argCount (FunTy _ _ ) = 2 +argCount (ForAllTy _ t) = argCount t +argCount (CastTy t _) = argCount t argCount _ = 0 simplify :: Type -> SimpleType -simplify (ForAllTy (Anon t1) t2) = SimpleType funTyConName [simplify t1, simplify t2] +simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] simplify (ForAllTy _ t) = simplify t simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) where (SimpleType s ts) = simplify t1 @@ -239,8 +239,9 @@ isTypeHidden expInfo = typeHidden case t of TyVarTy {} -> False AppTy t1 t2 -> typeHidden t1 || typeHidden t2 + FunTy t1 t2 -> typeHidden t1 || typeHidden t2 TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args - ForAllTy bndr ty -> typeHidden (binderType bndr) || typeHidden ty + ForAllTy bndr ty -> typeHidden (tyVarKind (binderVar bndr)) || typeHidden ty LitTy _ -> False CastTy ty _ -> typeHidden ty CoercionTy {} -> False diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index cb855693..c8e6b982 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -47,7 +47,7 @@ import Bag import RdrName import TcRnTypes import FastString (concatFS) -import BasicTypes ( StringLiteral(..) ) +import BasicTypes ( StringLiteral(..), SourceText(..) ) import qualified Outputable as O import HsDecls ( getConDetails ) @@ -163,7 +163,7 @@ mkAliasMap dflags mRenamedSource = Just (_,impDecls,_,_) -> M.fromList $ mapMaybe (\(SrcLoc.L _ impDecl) -> do - alias <- ideclAs impDecl + SrcLoc.L _ alias <- ideclAs impDecl return $ (lookupModuleDyn dflags (fmap Module.fsToUnitId $ @@ -305,16 +305,16 @@ mkMaps dflags gre instances decls = where loc = case d of TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs _ -> getInstLoc d + names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2]. names _ decl = getMainDeclBinder decl -- Note [2]: ------------ --- We relate ClsInsts to InstDecls using the SrcSpans buried inside them. --- That should work for normal user-written instances (from looking at GHC --- sources). We can assume that commented instances are user-written. --- This lets us relate Names (from ClsInsts) to comments (associated --- with InstDecls). - +-- We relate ClsInsts to InstDecls and DerivDecls using the SrcSpans buried +-- inside them. That should work for normal user-written instances (from +-- looking at GHC sources). We can assume that commented instances are +-- user-written. This lets us relate Names (from ClsInsts) to comments +-- (associated with InstDecls and DerivDecls). -------------------------------------------------------------------------------- -- Declarations @@ -338,7 +338,7 @@ subordinates instMap decl = case decl of , name <- getMainDeclBinder d, not (isValD d) ] dataSubs :: HsDataDefn Name -> [(Name, [HsDocString], Map Int HsDocString)] - dataSubs dd = constrs ++ fields + dataSubs dd = constrs ++ fields ++ derivs where cons = map unL $ (dd_cons dd) constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty) @@ -347,6 +347,11 @@ subordinates instMap decl = case decl of | RecCon flds <- map getConDetails cons , L _ (ConDeclField ns _ doc) <- (unLoc flds) , L _ n <- ns ] + derivs = [ (instName, [unL doc], M.empty) + | HsIB { hsib_body = L l (HsDocTy _ doc) } + <- concatMap (unLoc . deriv_clause_tys . unLoc) $ + unLoc $ dd_derivs dd + , Just instName <- [M.lookup l instMap] ] -- | Extract function argument docs from inside types. typeDocs :: HsDecl Name -> Map Int HsDocString @@ -394,12 +399,12 @@ mkFixMap group_ = M.fromList [ (n,f) -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'. ungroup :: HsGroup Name -> [LHsDecl Name] ungroup group_ = - mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++ + mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++ mkDecls hs_derivds DerivD group_ ++ mkDecls hs_defds DefD group_ ++ mkDecls hs_fords ForD group_ ++ mkDecls hs_docs DocD group_ ++ - mkDecls hs_instds InstD group_ ++ + mkDecls (tyClGroupInstDecls . hs_tyclds) InstD group_ ++ mkDecls (typesigs . hs_valds) SigD group_ ++ mkDecls (valbinds . hs_valds) ValD group_ where @@ -433,8 +438,9 @@ filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)] filterDecls = filter (isHandled . unL . fst) where isHandled (ForD (ForeignImport {})) = True - isHandled (TyClD {}) = True - isHandled (InstD {}) = True + isHandled (TyClD {}) = True + isHandled (InstD {}) = True + isHandled (DerivD {}) = True isHandled (SigD d) = isUserLSig (reL d) isHandled (ValD _) = True -- we keep doc declarations to be able to get at named docs @@ -504,10 +510,10 @@ mkExportItems Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls Just exports -> liftM concat $ mapM lookupExport exports where - lookupExport (IEVar (L _ x)) = declWith x - lookupExport (IEThingAbs (L _ t)) = declWith t - lookupExport (IEThingAll (L _ t)) = declWith t - lookupExport (IEThingWith (L _ t) _ _ _) = declWith t + lookupExport (IEVar (L _ x)) = declWith $ ieWrappedName x + lookupExport (IEThingAbs (L _ t)) = declWith $ ieWrappedName t + lookupExport (IEThingAll (L _ t)) = declWith $ ieWrappedName t + lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t lookupExport (IEModuleContents (L _ m)) = moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices lookupExport (IEGroup lev docStr) = return $ @@ -562,7 +568,7 @@ mkExportItems L loc (TyClD cl@ClassDecl{}) -> do mdef <- liftGhcToErrMsgGhc $ minimalDef t - let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef + let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef return [ mkExportDecl t (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ] @@ -756,11 +762,13 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap | otherwise = return Nothing mkExportItem decl@(L l (InstD d)) | Just name <- M.lookup (getInstLoc d) instMap = - let (doc, subs) = lookupDocs name warnings docMap argMap subMap in - return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices)) + expInst decl l name + mkExportItem decl@(L l (DerivD {})) + | Just name <- M.lookup l instMap = + expInst decl l name mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do mdef <- liftGhcToErrMsgGhc $ minimalDef name - let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef + let sig = maybeToList $ fmap (noLoc . MinimalSig NoSourceText . noLoc . fmap noLoc) mdef expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name mkExportItem decl@(L l d) | name:_ <- getMainDeclBinder d = expDecl decl l name @@ -772,6 +780,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap expDecl decl l name = return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices)) where (doc, subs) = lookupDocs name warnings docMap argMap subMap + expInst decl l name = + let (doc, subs) = lookupDocs name warnings docMap argMap subMap in + return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices)) + -- | Sometimes the declaration we want to export is not the "main" declaration: -- it might be an individual record selector or a class method. In these @@ -834,7 +846,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) = data_ty -- ResTyGADT _ ty <- con_res con = ty | ConDeclGADT{} <- con = hsib_body $ con_type con - | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs -- | Keep export items with docs. pruneExportItems :: [ExportItem Name] -> [ExportItem Name] diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 3054e2f9..f88d9f4e 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -179,7 +179,7 @@ renameLSigType :: LHsSigType Name -> RnM (LHsSigType DocName) renameLSigType = renameImplicit renameLType renameLSigWcType :: LHsSigWcType Name -> RnM (LHsSigWcType DocName) -renameLSigWcType = renameImplicit (renameWc renameLType) +renameLSigWcType = renameWc (renameImplicit renameLType) renameLKind :: LHsKind Name -> RnM (LHsKind DocName) renameLKind = renameLType @@ -219,7 +219,7 @@ renameType t = case t of ltype' <- renameLType ltype return (HsQualTy { hst_ctxt = lcontext', hst_body = ltype' }) - HsTyVar (L l n) -> return . HsTyVar . L l =<< rename n + HsTyVar ip (L l n) -> return . HsTyVar ip . L l =<< rename n HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype HsAppTy a b -> do @@ -238,6 +238,7 @@ renameType t = case t of HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2) HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts + HsSumTy ts -> HsSumTy <$> mapM renameLType ts HsOpTy a (L loc op) b -> do op' <- rename op @@ -261,7 +262,7 @@ renameType t = case t of HsRecTy a -> HsRecTy <$> mapM renameConDeclFieldField a HsCoreTy a -> pure (HsCoreTy a) - HsExplicitListTy a b -> HsExplicitListTy a <$> mapM renameLType b + HsExplicitListTy i a b -> HsExplicitListTy i a <$> mapM renameLType b HsExplicitTupleTy a b -> HsExplicitTupleTy a <$> mapM renameLType b HsSpliceTy _ _ -> error "renameType: HsSpliceTy" HsWildCardTy a -> HsWildCardTy <$> renameWildCardInfo a @@ -328,6 +329,9 @@ renameDecl decl = case decl of InstD d -> do d' <- renameInstD d return (InstD d') + DerivD d -> do + d' <- renameDerivD d + return (DerivD d') _ -> error "renameDecl" renameLThing :: (a Name -> RnM (a DocName)) -> Located (a Name) -> RnM (Located (a DocName)) @@ -340,19 +344,19 @@ renameTyClD d = case d of decl' <- renameFamilyDecl decl return (FamDecl { tcdFam = decl' }) - SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = _fvs } -> do + SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdRhs = rhs, tcdFVs = _fvs } -> do lname' <- renameL lname tyvars' <- renameLHsQTyVars tyvars rhs' <- renameLType rhs - return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = placeHolderNames }) + return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdRhs = rhs', tcdFVs = placeHolderNames }) - DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = _fvs } -> do + DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn, tcdFVs = _fvs } -> do lname' <- renameL lname tyvars' <- renameLHsQTyVars tyvars defn' <- renameDataDefn defn - return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames }) + return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdFixity = fixity, tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames }) - ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars + ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do lcontext' <- renameLContext lcontext lname' <- renameL lname @@ -363,6 +367,7 @@ renameTyClD d = case d of at_defs' <- mapM renameLTyFamDefltEqn at_defs -- we don't need the default methods or the already collected doc entities return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars' + , tcdFixity = fixity , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames }) @@ -376,7 +381,9 @@ renameTyClD d = case d of renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName) renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname - , fdTyVars = ltyvars, fdResultSig = result + , fdTyVars = ltyvars + , fdFixity = fixity + , fdResultSig = result , fdInjectivityAnn = injectivity }) = do info' <- renameFamilyInfo info lname' <- renameL lname @@ -384,7 +391,9 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname result' <- renameFamilyResultSig result injectivity' <- renameMaybeInjectivityAnn injectivity return (FamilyDecl { fdInfo = info', fdLName = lname' - , fdTyVars = ltyvars', fdResultSig = result' + , fdTyVars = ltyvars' + , fdFixity = fixity + , fdResultSig = result' , fdInjectivityAnn = injectivity' }) @@ -412,7 +421,8 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType cons' <- mapM (mapM renameCon) cons -- I don't think we need the derivings, so we return Nothing return (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext', dd_cType = cType - , dd_kindSig = k', dd_cons = cons', dd_derivs = Nothing }) + , dd_kindSig = k', dd_cons = cons' + , dd_derivs = noLoc [] }) renameCon :: ConDecl Name -> RnM (ConDecl DocName) renameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars @@ -467,10 +477,10 @@ renameSig sig = case sig of lnames' <- mapM renameL lnames ltype' <- renameLSigType sig_ty return (ClassOpSig is_default lnames' ltype') - PatSynSig lname sig_ty -> do - lname' <- renameL lname + PatSynSig lnames sig_ty -> do + lnames' <- mapM renameL lnames sig_ty' <- renameLSigType sig_ty - return $ PatSynSig lname' sig_ty' + return $ PatSynSig lnames' sig_ty' FixSig (FixitySig lnames fixity) -> do lnames' <- mapM renameL lnames return $ FixSig (FixitySig lnames' fixity) @@ -503,6 +513,15 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do d' <- renameDataFamInstD d return (DataFamInstD { dfid_inst = d' }) +renameDerivD :: DerivDecl Name -> RnM (DerivDecl DocName) +renameDerivD (DerivDecl { deriv_type = ty + , deriv_strategy = strat + , deriv_overlap_mode = omode }) = do + ty' <- renameLSigType ty + return (DerivDecl { deriv_type = ty' + , deriv_strategy = strat + , deriv_overlap_mode = omode }) + renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName) renameClsInstD (ClsInstDecl { cid_overlap_mode = omode , cid_poly_ty =ltype, cid_tyfam_insts = lATs @@ -523,30 +542,33 @@ renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn }) , tfid_fvs = placeHolderNames }) } renameLTyFamInstEqn :: LTyFamInstEqn Name -> RnM (LTyFamInstEqn DocName) -renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs })) +renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_fixity = fixity, tfe_rhs = rhs })) = do { tc' <- renameL tc ; pats' <- renameImplicit (mapM renameLType) pats ; rhs' <- renameLType rhs ; return (L loc (TyFamEqn { tfe_tycon = tc' , tfe_pats = pats' + , tfe_fixity = fixity , tfe_rhs = rhs' })) } renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName) -renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_rhs = rhs })) +renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_fixity = fixity, tfe_rhs = rhs })) = do { tc' <- renameL tc ; tvs' <- renameLHsQTyVars tvs ; rhs' <- renameLType rhs ; return (L loc (TyFamEqn { tfe_tycon = tc' , tfe_pats = tvs' + , tfe_fixity = fixity , tfe_rhs = rhs' })) } renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName) -renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats, dfid_defn = defn }) +renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats, dfid_fixity = fixity, dfid_defn = defn }) = do { tc' <- renameL tc ; pats' <- renameImplicit (mapM renameLType) pats ; defn' <- renameDataDefn defn ; return (DataFamInstDecl { dfid_tycon = tc' , dfid_pats = pats' + , dfid_fixity = fixity , dfid_defn = defn', dfid_fvs = placeHolderNames }) } renameImplicit :: (in_thing -> RnM out_thing) @@ -563,7 +585,7 @@ renameWc :: (in_thing -> RnM out_thing) renameWc rn_thing (HsWC { hswc_body = thing }) = do { thing' <- rn_thing thing ; return (HsWC { hswc_body = thing' - , hswc_wcs = PlaceHolder, hswc_ctx = Nothing }) } + , hswc_wcs = PlaceHolder }) } renameDocInstance :: DocInstance Name -> RnM (DocInstance DocName) renameDocInstance (inst, idoc, L l n) = do diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index ab719fe8..28bbf305 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -36,7 +36,7 @@ specialize :: (Eq name, Typeable name) specialize name details = everywhere $ mkT step where - step (HsTyVar (L _ name')) | name == name' = details + step (HsTyVar _ (L _ name')) | name == name' = details step typ = typ @@ -81,10 +81,10 @@ specializeSig :: forall name . (Eq name, DataId name, SetName name) -> Sig name -> Sig name specializeSig bndrs typs (TypeSig lnames typ) = - TypeSig lnames (typ { hsib_body = (hsib_body typ) { hswc_body = noLoc typ'}}) + TypeSig lnames (typ { hswc_body = (hswc_body typ) { hsib_body = noLoc typ'}}) where true_type :: HsType name - true_type = unLoc (hswc_body (hsib_body typ)) + true_type = unLoc (hsSigWcType typ) typ' :: HsType name typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs true_type fv = foldr Set.union Set.empty . map freeVariables $ typs @@ -123,7 +123,7 @@ sugar = sugarLists :: NamedThing name => HsType name -> HsType name -sugarLists (HsAppTy (L _ (HsTyVar (L _ name))) ltyp) +sugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp) | isBuiltInSyntax name' && strName == "[]" = HsListTy ltyp where name' = getName name @@ -137,7 +137,7 @@ sugarTuples typ = where aux apps (HsAppTy (L _ ftyp) atyp) = aux (atyp:apps) ftyp aux apps (HsParTy (L _ typ')) = aux apps typ' - aux apps (HsTyVar (L _ name)) + aux apps (HsTyVar _ (L _ name)) | isBuiltInSyntax name' && suitable = HsTupleTy HsBoxedTuple apps where name' = getName name @@ -149,7 +149,7 @@ sugarTuples typ = sugarOperators :: NamedThing name => HsType name -> HsType name -sugarOperators (HsAppTy (L _ (HsAppTy (L _ (HsTyVar (L l name))) la)) lb) +sugarOperators (HsAppTy (L _ (HsAppTy (L _ (HsTyVar _ (L l name))) la)) lb) | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy la lb where @@ -224,7 +224,7 @@ freeVariables = query term ctx = case cast term :: Maybe (HsType name) of Just (HsForAllTy bndrs _) -> (Set.empty, Set.union ctx (bndrsNames bndrs)) - Just (HsTyVar (L _ name)) + Just (HsTyVar _ (L _ name)) | getName name `Set.member` ctx -> (Set.empty, ctx) | otherwise -> (Set.singleton $ getNameRep name, ctx) _ -> (Set.empty, ctx) @@ -267,12 +267,13 @@ renameType (HsQualTy lctxt lt) = HsQualTy <$> located renameContext lctxt <*> renameLType lt -renameType (HsTyVar name) = HsTyVar <$> located renameName name +renameType (HsTyVar ip name) = HsTyVar ip <$> located renameName name renameType (HsAppTy lf la) = HsAppTy <$> renameLType lf <*> renameLType la renameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr renameType (HsListTy lt) = HsListTy <$> renameLType lt renameType (HsPArrTy lt) = HsPArrTy <$> renameLType lt renameType (HsTupleTy srt lt) = HsTupleTy srt <$> mapM renameLType lt +renameType (HsSumTy lt) = HsSumTy <$> mapM renameLType lt renameType (HsOpTy la lop lb) = HsOpTy <$> renameLType la <*> located renameName lop <*> renameLType lb renameType (HsParTy lt) = HsParTy <$> renameLType lt @@ -284,8 +285,8 @@ renameType (HsDocTy lt doc) = HsDocTy <$> renameLType lt <*> pure doc renameType (HsBangTy bang lt) = HsBangTy bang <$> renameLType lt renameType t@(HsRecTy _) = pure t renameType t@(HsCoreTy _) = pure t -renameType (HsExplicitListTy ph ltys) = - HsExplicitListTy ph <$> renameLTypes ltys +renameType (HsExplicitListTy ip ph ltys) = + HsExplicitListTy ip ph <$> renameLTypes ltys renameType (HsExplicitTupleTy phs ltys) = HsExplicitTupleTy phs <$> renameLTypes ltys renameType t@(HsTyLit _) = pure t |