-cvtType ty = do { (head_ty, tys') <- split_ty_app ty
- ; case head_ty of
- TupleT n | length tys' == n -- Saturated
- -> if n==1 then return (head tys') -- Singleton tuples treated
- -- like nothing (ie just parens)
- else returnL (HsTupleTy Boxed tys')
- | n == 1 -> failWith (ptext (sLit "Illegal 1-tuple type constructor"))
- | otherwise -> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
- ArrowT | [x',y'] <- tys' -> returnL (HsFunTy x' y')
- | otherwise -> mk_apps (HsTyVar (getRdrName funTyCon)) tys'
- ListT | [x'] <- tys' -> returnL (HsListTy x')
- | otherwise -> mk_apps (HsTyVar (getRdrName listTyCon)) tys'
- VarT nm -> do { nm' <- tName nm; mk_apps (HsTyVar nm') tys' }
- ConT nm -> do { nm' <- tconName nm; mk_apps (HsTyVar nm') tys' }
-
- ForallT tvs cxt ty | null tys' -> do { tvs' <- cvtTvs tvs
- ; cxt' <- cvtContext cxt
- ; ty' <- cvtType ty
- ; returnL $ mkExplicitHsForAllTy tvs' cxt' ty' }
- _ -> failWith (ptext (sLit "Malformed type") <+> text (show ty))
- }
+cvtType ty
+ = do { (head_ty, tys') <- split_ty_app ty
+ ; case head_ty of
+ TupleT n
+ | length tys' == n -- Saturated
+ -> if n==1 then return (head tys') -- Singleton tuples treated
+ -- like nothing (ie just parens)
+ else returnL (HsTupleTy Boxed tys')
+ | n == 1
+ -> failWith (ptext (sLit "Illegal 1-tuple type constructor"))
+ | otherwise
+ -> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
+ ArrowT
+ | [x',y'] <- tys' -> returnL (HsFunTy x' y')
+ | otherwise -> mk_apps (HsTyVar (getRdrName funTyCon)) tys'
+ ListT
+ | [x'] <- tys' -> returnL (HsListTy x')
+ | otherwise -> mk_apps (HsTyVar (getRdrName listTyCon)) tys'
+ VarT nm -> do { nm' <- tName nm; mk_apps (HsTyVar nm') tys' }
+ ConT nm -> do { nm' <- tconName nm; mk_apps (HsTyVar nm') tys' }
+
+ ForallT tvs cxt ty
+ | null tys'
+ -> do { tvs' <- cvtTvs tvs
+ ; cxt' <- cvtContext cxt
+ ; ty' <- cvtType ty
+ ; returnL $ mkExplicitHsForAllTy tvs' cxt' ty'
+ }
+
+ SigT ty ki
+ -> do { ty' <- cvtType ty
+ ; mk_apps (HsKindSig ty' (cvtKind ki)) tys'
+ }
+
+ _ -> failWith (ptext (sLit "Malformed type") <+> text (show ty))
+ }