- | isRdrTc tc = do tvs <- extractTyVars acc
- return (L l tc, tvs, acc)
- go l (HsOpTy t1 ltc@(L _ tc) t2) acc
- | isRdrTc tc = do tvs <- extractTyVars (t1:t2:acc)
- return (ltc, tvs, acc)
- go l (HsParTy ty) acc = gol ty acc
- go l (HsAppTy t1 t2) acc = gol t1 (t2:acc)
- go l other acc =
- parseError l "Malformed head of type or class declaration"
-
- -- The predicates in a type or class decl must be class predicates or
- -- equational constraints. They need not all have variable-only
- -- arguments, even in Haskell 98.
- -- E.g. class (Monad m, Monad (t m)) => MonadT t m
- chk_pred (L l (HsClassP _ _)) = return ()
- chk_pred (L l (HsEqualP _ _)) = return ()
- chk_pred (L l _)
- = parseError l "Malformed context in type or class declaration"
-
--- Extract the type variables of a list of type parameters.
---
--- * Type arguments can be complex type terms (needed for associated type
--- declarations).
---
-extractTyVars :: [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
-extractTyVars tvs = collects [] tvs
- where
- -- Collect all variables (1st arg serves as an accumulator)
- collect tvs (L l (HsForAllTy _ _ _ _)) =
- parseError l "Forall type not allowed as type parameter"
- collect tvs (L l (HsTyVar tv))
- | isRdrTyVar tv = return $ L l (UserTyVar tv) : tvs
- | otherwise = return tvs
- collect tvs (L l (HsBangTy _ _ )) =
- parseError l "Bang-style type annotations not allowed as type parameter"
- collect tvs (L l (HsAppTy t1 t2 )) = do
- tvs' <- collect tvs t2
- collect tvs' t1
- collect tvs (L l (HsFunTy t1 t2 )) = do
- tvs' <- collect tvs t2
- collect tvs' t1
- collect tvs (L l (HsListTy t )) = collect tvs t
- collect tvs (L l (HsPArrTy t )) = collect tvs t
- collect tvs (L l (HsTupleTy _ ts )) = collects tvs ts
- collect tvs (L l (HsOpTy t1 _ t2 )) = do
- tvs' <- collect tvs t2
- collect tvs' t1
- collect tvs (L l (HsParTy t )) = collect tvs t
- collect tvs (L l (HsNumTy t )) = return tvs
- collect tvs (L l (HsPredTy t )) =
- parseError l "Predicate not allowed as type parameter"
- collect tvs (L l (HsKindSig (L _ (HsTyVar tv)) k))
- | isRdrTyVar tv =
- return $ L l (KindedTyVar tv k) : tvs
- | otherwise =
- parseError l "Kind signature only allowed for type variables"
- collect tvs (L l (HsSpliceTy t )) =
- parseError l "Splice not allowed as type parameter"
-
- -- Collect all variables of a list of types
- collects tvs [] = return tvs
- collects tvs (t:ts) = do
- tvs' <- collects tvs ts
- collect tvs' t