diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2017-05-23 23:16:32 +0200 |
---|---|---|
committer | Alan Zimmerman <alan.zimm@gmail.com> | 2017-06-05 22:26:55 +0200 |
commit | 1e1f85d6513b84bac3ae13470900ac7c23e8640e (patch) | |
tree | 8a8de8b9a2507ce126aa8b9e4d7939e43e264bcc /haddock-api/src/Haddock/Convert.hs | |
parent | a1b57146c5678b32eb5ac37021e93a81a4b73007 (diff) |
Match new AST as per GHC wip/new-tree-one-param
See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow
Diffstat (limited to 'haddock-api/src/Haddock/Convert.hs')
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 40 |
1 files changed, 20 insertions, 20 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 01261477..03134695 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -49,7 +49,7 @@ import Haddock.Interface.Specialize -- the main function here! yay! -tyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl Name)) +tyThingToLHsDecl :: TyThing -> Either ErrMsg ([ErrMsg], (HsDecl GHCR)) tyThingToLHsDecl t = case t of -- ids (functions and zero-argument a.k.a. CAFs) get a type signature. -- Including built-in functions like seq. @@ -108,7 +108,7 @@ tyThingToLHsDecl t = case t of withErrs e x = return (e, x) allOK x = return (mempty, x) -synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn Name +synifyAxBranch :: TyCon -> CoAxBranch -> TyFamInstEqn GHCR synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) = let name = synifyName tc typats = map (synifyType WithinType) args @@ -120,7 +120,7 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) , tfe_fixity = Prefix , tfe_rhs = hs_rhs } -synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl Name) +synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GHCR) synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) | isOpenTypeFamilyTyCon tc , Just branch <- coAxiomSingleBranch_maybe ax @@ -136,7 +136,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) = Left "synifyAxiom: closed/open family confusion" -- | Turn type constructors into type class declarations -synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl Name) +synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl GHCR) synifyTyCon _coax tc | isFunTyCon tc || isPrimTyCon tc = return $ @@ -247,14 +247,14 @@ synifyTyCon coax tc dataConErrs -> Left $ unlines dataConErrs synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity - -> Maybe (LInjectivityAnn Name) + -> Maybe (LInjectivityAnn GHCR) synifyInjectivityAnn Nothing _ _ = Nothing synifyInjectivityAnn _ _ NotInjective = Nothing synifyInjectivityAnn (Just lhs) tvs (Injective inj) = let rhs = map (noLoc . tyVarName) (filterByList inj tvs) in Just $ noLoc $ InjectivityAnn (noLoc lhs) rhs -synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig Name +synifyFamilyResultSig :: Maybe Name -> Kind -> LFamilyResultSig GHCR synifyFamilyResultSig Nothing kind = noLoc $ KindSig (synifyKindSig kind) synifyFamilyResultSig (Just name) kind = @@ -265,7 +265,7 @@ synifyFamilyResultSig (Just name) kind = -- result-type. -- But you might want pass False in simple enough cases, -- if you think it looks better. -synifyDataCon :: Bool -> DataCon -> Either ErrMsg (LConDecl Name) +synifyDataCon :: Bool -> DataCon -> Either ErrMsg (LConDecl GHCR) synifyDataCon use_gadt_syntax dc = let -- dataConIsInfix allegedly tells us whether it was declared with @@ -322,22 +322,22 @@ synifyName :: NamedThing n => n -> Located Name synifyName = noLoc . getName -synifyIdSig :: SynifyTypeState -> Id -> Sig Name +synifyIdSig :: SynifyTypeState -> Id -> Sig GHCR synifyIdSig s i = TypeSig [synifyName i] (synifySigWcType s (varType i)) -synifyTcIdSig :: SynifyTypeState -> Id -> Sig Name +synifyTcIdSig :: SynifyTypeState -> Id -> Sig GHCR synifyTcIdSig s i = ClassOpSig False [synifyName i] (synifySigType s (varType i)) -synifyCtx :: [PredType] -> LHsContext Name +synifyCtx :: [PredType] -> LHsContext GHCR synifyCtx = noLoc . map (synifyType WithinType) -synifyTyVars :: [TyVar] -> LHsQTyVars Name +synifyTyVars :: [TyVar] -> LHsQTyVars GHCR synifyTyVars ktvs = HsQTvs { hsq_implicit = [] , hsq_explicit = map synifyTyVar ktvs , hsq_dependent = emptyNameSet } -synifyTyVar :: TyVar -> LHsTyVarBndr Name +synifyTyVar :: TyVar -> LHsTyVarBndr GHCR synifyTyVar tv | isLiftedTypeKind kind = noLoc (UserTyVar (noLoc name)) | otherwise = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind)) @@ -361,20 +361,20 @@ data SynifyTypeState -- the defining class gets to quantify all its functions for free! -synifySigType :: SynifyTypeState -> Type -> LHsSigType Name +synifySigType :: SynifyTypeState -> Type -> LHsSigType GHCR -- The empty binders is a bit suspicious; -- what if the type has free variables? synifySigType s ty = mkEmptyImplicitBndrs (synifyType s ty) -synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType Name +synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType GHCR -- Ditto (see synifySigType) synifySigWcType s ty = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs (synifyType s ty)) -synifyPatSynSigType :: PatSyn -> LHsSigType Name +synifyPatSynSigType :: PatSyn -> LHsSigType GHCR -- Ditto (see synifySigType) synifyPatSynSigType ps = mkEmptyImplicitBndrs (synifyPatSynType ps) -synifyType :: SynifyTypeState -> Type -> LHsType Name +synifyType :: SynifyTypeState -> Type -> LHsType GHCR synifyType _ (TyVarTy tv) = noLoc $ HsTyVar NotPromoted $ noLoc (getName tv) synifyType _ (TyConApp tc tys) -- Use */# instead of TYPE 'Lifted/TYPE 'Unlifted (#473) @@ -431,7 +431,7 @@ synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t synifyType s (CastTy t _) = synifyType s t synifyType _ (CoercionTy {}) = error "synifyType:Coercion" -synifyPatSynType :: PatSyn -> LHsType Name +synifyPatSynType :: PatSyn -> LHsType GHCR synifyPatSynType ps = let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, res_ty) = patSynSig ps req_theta' | null req_theta && not (null prov_theta && null ex_tvs) = [unitTy] @@ -451,10 +451,10 @@ synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s -synifyKindSig :: Kind -> LHsKind Name +synifyKindSig :: Kind -> LHsKind GHCR synifyKindSig k = synifyType WithinType k -synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name +synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead GHCR synifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead { ihdClsName = getName cls , ihdKinds = map (unLoc . synifyType WithinType) ks @@ -473,7 +473,7 @@ synifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead synifyClsIdSig = synifyIdSig DeleteTopLevelQuantification -- Convert a family instance, this could be a type family or data family -synifyFamInst :: FamInst -> Bool -> Either ErrMsg (InstHead Name) +synifyFamInst :: FamInst -> Bool -> Either ErrMsg (InstHead GHCR) synifyFamInst fi opaque = do ityp' <- ityp $ fi_flavor fi return InstHead |