- gol (L l ty) acc = go l ty acc
-
- go l (HsTyVar tc) acc
- | not (isRdrTyVar tc) = do
- tvs <- extractTyVars acc
- return (L l tc, tvs, acc)
- go l (HsOpTy t1 tc t2) acc = do
- tvs <- extractTyVars (t1:t2:acc)
- return (tc, 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 all
- -- be HsClassPs. They need not all be type variables,
- -- even in Haskell 98. E.g. class (Monad m, Monad (t m)) => MonadT t m
- chk_pred (L l (HsClassP _ args)) = 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
+ goL (L l ty) acc = go l ty acc
+
+ go l (HsTyVar tc) acc
+ | isRdrTc tc = return (L l tc, acc)
+
+ go _ (HsOpTy t1 ltc@(L _ tc) t2) acc
+ | isRdrTc tc = return (ltc, t1:t2:acc)
+ go _ (HsParTy ty) acc = goL ty acc
+ go _ (HsAppTy t1 t2) acc = goL t1 (t2:acc)
+ go l _ _ = parseError l "Malformed head of type or class declaration"