2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsTypes]{Abstract syntax: user-defined types}
8 HsType(..), HsTyVarBndr(..), HsExplicitForAll(..),
9 , HsContext, HsPred(..)
11 , mkExplicitHsForAllTy, mkImplicitHsForAllTy,
12 , mkHsDictTy, mkHsIParamTy
13 , hsTyVarName, hsTyVarNames, replaceTyVarName
17 , PostTcType, placeHolderType,
20 , SyntaxName, placeHolderName,
23 , pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
26 #include "HsVersions.h"
28 import TcType ( Type, Kind, liftedTypeKind, eqKind )
29 import TypeRep ( Type )
30 import Name ( Name, mkInternalName )
31 import OccName ( mkVarOcc )
32 import PprType ( {- instance Outputable Kind -}, pprParendKind, pprKind )
33 import BasicTypes ( IPName, Boxity, tupleParens )
34 import PrelNames ( unboundKey )
35 import SrcLoc ( noSrcLoc )
36 import CmdLineOpts ( opt_PprStyle_Debug )
41 %************************************************************************
43 \subsection{Annotating the syntax}
45 %************************************************************************
48 type PostTcType = Type -- Used for slots in the abstract syntax
49 -- where we want to keep slot for a type
50 -- to be added by the type checker...but
51 -- before typechecking it's just bogus
53 placeHolderType :: PostTcType -- Used before typechecking
54 placeHolderType = panic "Evaluated the place holder for a PostTcType"
57 type SyntaxName = Name -- These names are filled in by the renamer
58 -- Before then they are a placeHolderName (so that
59 -- we can still print the HsSyn)
60 -- They correspond to "rebindable syntax";
61 -- See RnEnv.lookupSyntaxName
63 placeHolderName :: SyntaxName
64 placeHolderName = mkInternalName unboundKey
65 (mkVarOcc FSLIT("syntaxPlaceHolder"))
70 %************************************************************************
72 \subsection{Data types}
74 %************************************************************************
76 This is the syntax for types as seen in type signatures.
79 type HsContext name = [HsPred name]
81 data HsPred name = HsClassP name [HsType name]
82 | HsIParam (IPName name) (HsType name)
85 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
86 -- the user wrote it originally, so that the printer can
87 -- print it as the user wrote it
88 [HsTyVarBndr name] -- With ImplicitForAll, this is the empty list
89 -- until the renamer fills in the variables
93 | HsTyVar name -- Type variable or type constructor
95 | HsAppTy (HsType name)
98 | HsFunTy (HsType name) -- function type
101 | HsListTy (HsType name) -- Element type
103 | HsPArrTy (HsType name) -- Elem. type of parallel array: [:t:]
106 [HsType name] -- Element types (length gives arity)
108 | HsOpTy (HsType name) name (HsType name)
110 | HsParTy (HsType name)
111 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
112 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
114 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
115 -- interface files smaller), so when printing a HsType we may need to
118 | HsNumTy Integer -- Generics only
120 -- these next two are only used in interfaces
121 | HsPredTy (HsPred name)
123 | HsKindSig (HsType name) -- (ty :: kind)
124 Kind -- A type with a kind signature
126 data HsExplicitForAll = Explicit | Implicit
128 -----------------------
129 -- Combine adjacent for-alls.
130 -- The following awkward situation can happen otherwise:
131 -- f :: forall a. ((Num a) => Int)
132 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
133 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
134 -- but the export list abstracts f wrt [a]. Disaster.
136 -- A valid type must have one for-all at the top of the type, or of the fn arg types
138 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
139 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
141 mkHsForAllTy :: HsExplicitForAll -> [HsTyVarBndr name] -> HsContext name -> HsType name -> HsType name
142 -- Smart constructor for HsForAllTy
143 mkHsForAllTy exp tvs [] ty = mk_forall_ty exp tvs ty
144 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
146 -- mk_forall_ty makes a pure for-all type (no context)
147 mk_forall_ty Explicit [] ty = ty -- Explicit for-all with no tyvars
148 mk_forall_ty exp tvs (HsParTy ty) = mk_forall_ty exp tvs ty
149 mk_forall_ty exp1 tvs1 (HsForAllTy exp2 tvs2 ctxt ty) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
150 mk_forall_ty exp tvs ty = HsForAllTy exp tvs [] ty
152 Implicit `plus` Implicit = Implicit
153 exp1 `plus` exp2 = Explicit
155 mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
156 mkHsIParamTy v ty = HsPredTy (HsIParam v ty)
158 data HsTyVarBndr name
160 | KindedTyVar name Kind
161 -- *** NOTA BENE *** A "monotype" in a pragma can have
162 -- for-alls in it, (mostly to do with dictionaries). These
163 -- must be explicitly Kinded.
165 hsTyVarName (UserTyVar n) = n
166 hsTyVarName (KindedTyVar n _) = n
168 hsTyVarNames tvs = map hsTyVarName tvs
170 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
171 replaceTyVarName (UserTyVar n) n' = UserTyVar n'
172 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
180 -> ([HsTyVarBndr name], HsContext name, name, [HsType name])
181 -- Split up an instance decl type, returning the pieces
183 -- In interface files, the instance declaration head is created
184 -- by HsTypes.toHsType, which does not guarantee to produce a
185 -- HsForAllTy. For example, if we had the weird decl
186 -- instance Foo T => Foo [T]
187 -- then we'd get the instance type
189 -- So when colleting the instance context, to be on the safe side
190 -- we gather predicate arguments
192 -- For source code, the parser ensures the type will have the right shape.
193 -- (e.g. see ParseUtil.checkInstType)
195 splitHsInstDeclTy inst_ty
197 HsForAllTy _ tvs cxt1 tau -- The type vars should have been
198 -- computed by now, even if they were implicit
199 -> (tvs, cxt1++cxt2, cls, tys)
201 (cxt2, cls, tys) = split_tau tau
203 other -> ([], cxt2, cls, tys)
205 (cxt2, cls, tys) = split_tau inst_ty
208 split_tau (HsFunTy (HsPredTy p) ty) = (p:ps, cls, tys)
210 (ps, cls, tys) = split_tau ty
211 split_tau (HsPredTy (HsClassP cls tys)) = ([], cls,tys)
212 split_tau other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
216 %************************************************************************
218 \subsection{Pretty printing}
220 %************************************************************************
222 NB: these types get printed into interface files, so
223 don't change the printing format lightly
226 instance (Outputable name) => Outputable (HsType name) where
227 ppr ty = pprHsType ty
229 instance (Outputable name) => Outputable (HsTyVarBndr name) where
230 ppr (UserTyVar name) = ppr name
231 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
233 instance Outputable name => Outputable (HsPred name) where
234 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprParendHsType tys)
235 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
237 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
238 pprHsTyVarBndr name kind | kind `eqKind` liftedTypeKind = ppr name
239 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
241 pprHsForAll exp tvs cxt
242 | show_forall = forall_part <+> pprHsContext cxt
243 | otherwise = pprHsContext cxt
245 show_forall = opt_PprStyle_Debug
246 || (not (null tvs) && is_explicit)
247 is_explicit = case exp of {Explicit -> True; Implicit -> False}
248 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
250 pprHsContext :: (Outputable name) => HsContext name -> SDoc
251 pprHsContext [] = empty
252 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
254 ppr_hs_context [] = empty
255 ppr_hs_context cxt = parens (interpp'SP cxt)
259 pREC_TOP = (0 :: Int) -- type in ParseIface.y
260 pREC_FUN = (1 :: Int) -- btype in ParseIface.y
261 -- Used for LH arg of (->)
262 pREC_OP = (2 :: Int) -- Used for arg of any infix operator
263 -- (we don't keep their fixities around)
264 pREC_CON = (3 :: Int) -- Used for arg of type applicn:
265 -- always parenthesise unless atomic
267 maybeParen :: Int -- Precedence of context
268 -> Int -- Precedence of top-level operator
269 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
270 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
273 -- printing works more-or-less as for Types
275 pprHsType, pprParendHsType :: (Outputable name) => HsType name -> SDoc
277 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
278 pprParendHsType ty = ppr_mono_ty pREC_CON ty
280 -- Before printing a type
281 -- (a) Remove outermost HsParTy parens
282 -- (b) Drop top-level for-all type variables in user style
283 -- since they are implicit in Haskell
284 prepare sty (HsParTy ty) = prepare sty ty
287 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
288 = maybeParen ctxt_prec pREC_FUN $
289 sep [pprHsForAll exp tvs ctxt, ppr_mono_ty pREC_TOP ty]
291 ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
292 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
293 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
294 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
295 ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_ty pREC_TOP ty)
296 ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_ty pREC_TOP ty)
297 ppr_mono_ty ctxt_prec (HsPredTy pred) = braces (ppr pred)
298 ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
300 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
301 = maybeParen ctxt_prec pREC_CON $
302 hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty]
304 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
305 = maybeParen ctxt_prec pREC_OP $
306 ppr_mono_ty pREC_OP ty1 <+> ppr op <+> ppr_mono_ty pREC_OP ty2
308 ppr_mono_ty ctxt_prec (HsParTy ty)
309 = parens (ppr_mono_ty pREC_TOP ty)
310 -- Put the parens in where the user did
311 -- But we still use the precedence stuff to add parens because
312 -- toHsType doesn't put in any HsParTys, so we may still need them
314 --------------------------
315 ppr_fun_ty ctxt_prec ty1 ty2
316 = let p1 = ppr_mono_ty pREC_FUN ty1
317 p2 = ppr_mono_ty pREC_TOP ty2
319 maybeParen ctxt_prec pREC_FUN $
320 sep [p1, ptext SLIT("->") <+> p2]
322 --------------------------
323 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")