2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 HsTypes: Abstract syntax: user-defined types
11 HsTyVarBndr(..), LHsTyVarBndr,
13 HsContext, LHsContext,
17 LBangType, BangType, HsBang(..),
18 getBangType, getBangStrictness,
20 ConDeclField(..), pprConDeclFields,
22 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
23 hsTyVarName, hsTyVarNames, replaceTyVarName,
24 hsTyVarKind, hsTyVarNameKind,
25 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
26 splitHsInstDeclTy, splitHsFunType,
29 PostTcType, placeHolderType, PostTcKind, placeHolderKind,
32 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
35 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
37 import NameSet( FreeVars )
48 %************************************************************************
50 \subsection{Annotating the syntax}
52 %************************************************************************
55 type PostTcKind = Kind
56 type PostTcType = Type -- Used for slots in the abstract syntax
57 -- where we want to keep slot for a type
58 -- to be added by the type checker...but
59 -- before typechecking it's just bogus
61 placeHolderType :: PostTcType -- Used before typechecking
62 placeHolderType = panic "Evaluated the place holder for a PostTcType"
64 placeHolderKind :: PostTcKind -- Used before typechecking
65 placeHolderKind = panic "Evaluated the place holder for a PostTcKind"
68 %************************************************************************
70 Quasi quotes; used in types and elsewhere
72 %************************************************************************
75 data HsQuasiQuote id = HsQuasiQuote
76 id -- The quasi-quoter
77 SrcSpan -- The span of the enclosed string
78 FastString -- The enclosed string
80 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
83 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
84 ppr_qq (HsQuasiQuote quoter _ quote) =
85 char '[' <> ppr quoter <> ptext (sLit "|") <>
86 ppr quote <> ptext (sLit "|]")
90 %************************************************************************
92 \subsection{Bang annotations}
94 %************************************************************************
97 type LBangType name = Located (BangType name)
98 type BangType name = HsType name -- Bangs are in the HsType data type
100 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
101 -- never appears on a HsBangTy
103 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
105 instance Outputable HsBang where
106 ppr (HsNoBang) = empty
107 ppr (HsStrict) = char '!'
108 ppr (HsUnbox) = ptext (sLit "!!")
110 getBangType :: LHsType a -> LHsType a
111 getBangType (L _ (HsBangTy _ ty)) = ty
114 getBangStrictness :: LHsType a -> HsBang
115 getBangStrictness (L _ (HsBangTy s _)) = s
116 getBangStrictness _ = HsNoBang
120 %************************************************************************
122 \subsection{Data types}
124 %************************************************************************
126 This is the syntax for types as seen in type signatures.
129 type LHsContext name = Located (HsContext name)
131 type HsContext name = [LHsPred name]
133 type LHsPred name = Located (HsPred name)
135 data HsPred name = HsClassP name [LHsType name] -- class constraint
136 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
137 | HsIParam (IPName name) (LHsType name)
139 type LHsType name = Located (HsType name)
142 = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way
143 -- the user wrote it originally, so that the printer can
144 -- print it as the user wrote it
145 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
146 -- until the renamer fills in the variables
150 | HsTyVar name -- Type variable or type constructor
152 | HsAppTy (LHsType name)
155 | HsFunTy (LHsType name) -- function type
158 | HsListTy (LHsType name) -- Element type
160 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
163 [LHsType name] -- Element types (length gives arity)
165 | HsOpTy (LHsType name) (Located name) (LHsType name)
167 | HsParTy (LHsType name)
168 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
169 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
171 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
172 -- interface files smaller), so when printing a HsType we may need to
175 | HsNumTy Integer -- Generics only
177 | HsPredTy (HsPred name) -- Only used in the type of an instance
178 -- declaration, eg. Eq [a] -> Eq a
181 -- Note no need for location info on the
182 -- enclosed HsPred; the one on the type will do
184 | HsKindSig (LHsType name) -- (ty :: kind)
185 Kind -- A type with a kind signature
187 | HsQuasiQuoteTy (HsQuasiQuote name)
189 | HsSpliceTy (HsSplice name)
190 FreeVars -- Variables free in the splice (filled in by renamer)
193 | HsDocTy (LHsType name) LHsDocString -- A documented type
195 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
196 | HsRecTy [ConDeclField name] -- Only in data type declarations
198 data HsExplicitFlag = Explicit | Implicit
200 data ConDeclField name -- Record fields have Haddoc docs on them
201 = ConDeclField { cd_fld_name :: Located name,
202 cd_fld_type :: LBangType name,
203 cd_fld_doc :: Maybe LHsDocString }
206 -----------------------
207 -- Combine adjacent for-alls.
208 -- The following awkward situation can happen otherwise:
209 -- f :: forall a. ((Num a) => Int)
210 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
211 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
212 -- but the export list abstracts f wrt [a]. Disaster.
214 -- A valid type must have one for-all at the top of the type, or of the fn arg types
216 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
217 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
218 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
219 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
221 mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
222 -- Smart constructor for HsForAllTy
223 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
224 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
226 -- mk_forall_ty makes a pure for-all type (no context)
227 mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsType name -> HsType name
228 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
229 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
230 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
231 -- Even if tvs is empty, we still make a HsForAll!
232 -- In the Implicit case, this signals the place to do implicit quantification
233 -- In the Explicit case, it prevents implicit quantification
234 -- (see the sigtype production in Parser.y.pp)
235 -- so that (forall. ty) isn't implicitly quantified
237 plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
238 Implicit `plus` Implicit = Implicit
239 _ `plus` _ = Explicit
241 hsExplicitTvs :: LHsType name -> [name]
242 -- The explicitly-given forall'd type variables of a HsType
243 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
246 ---------------------
247 type LHsTyVarBndr name = Located (HsTyVarBndr name)
249 data HsTyVarBndr name
250 = UserTyVar -- No explicit kinding
251 name -- See Note [Printing KindedTyVars]
257 -- *** NOTA BENE *** A "monotype" in a pragma can have
258 -- for-alls in it, (mostly to do with dictionaries). These
259 -- must be explicitly Kinded.
261 hsTyVarName :: HsTyVarBndr name -> name
262 hsTyVarName (UserTyVar n _) = n
263 hsTyVarName (KindedTyVar n _) = n
265 hsTyVarKind :: HsTyVarBndr name -> Kind
266 hsTyVarKind (UserTyVar _ k) = k
267 hsTyVarKind (KindedTyVar _ k) = k
269 hsTyVarNameKind :: HsTyVarBndr name -> (name, Kind)
270 hsTyVarNameKind (UserTyVar n k) = (n,k)
271 hsTyVarNameKind (KindedTyVar n k) = (n,k)
273 hsLTyVarName :: LHsTyVarBndr name -> name
274 hsLTyVarName = hsTyVarName . unLoc
276 hsTyVarNames :: [HsTyVarBndr name] -> [name]
277 hsTyVarNames tvs = map hsTyVarName tvs
279 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
280 hsLTyVarNames = map hsLTyVarName
282 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
283 hsLTyVarLocName = fmap hsTyVarName
285 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
286 hsLTyVarLocNames = map hsLTyVarLocName
288 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
289 replaceTyVarName (UserTyVar _ k) n' = UserTyVar n' k
290 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
296 :: OutputableBndr name
298 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
299 -- Split up an instance decl type, returning the pieces
301 splitHsInstDeclTy inst_ty
303 HsParTy (L _ ty) -> splitHsInstDeclTy ty
304 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
305 other -> split_tau [] [] other
306 -- The type vars should have been computed by now, even if they were implicit
308 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
309 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
310 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
312 -- Splits HsType into the (init, last) parts
313 -- Breaks up any parens in the result type:
314 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
315 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
316 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
318 (args, res) = splitHsFunType y
319 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
320 splitHsFunType other = ([], other)
324 %************************************************************************
326 \subsection{Pretty printing}
328 %************************************************************************
331 instance (OutputableBndr name) => Outputable (HsType name) where
332 ppr ty = pprHsType ty
334 instance (Outputable name) => Outputable (HsTyVarBndr name) where
335 ppr (UserTyVar name _) = ppr name
336 ppr (KindedTyVar name kind) = hsep [ppr name, dcolon, pprParendKind kind]
338 instance OutputableBndr name => Outputable (HsPred name) where
339 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
340 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
342 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
344 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
345 pprLHsType = pprParendHsType . unLoc
347 pprHsForAll :: OutputableBndr name => HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
348 pprHsForAll exp tvs cxt
349 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
350 | otherwise = pprHsContext (unLoc cxt)
352 show_forall = opt_PprStyle_Debug
353 || (not (null tvs) && is_explicit)
354 is_explicit = case exp of {Explicit -> True; Implicit -> False}
355 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
357 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
358 pprHsContext [] = empty
359 pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
361 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
362 ppr_hs_context [] = empty
363 ppr_hs_context cxt = parens (interpp'SP cxt)
365 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
366 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
368 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
370 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
373 Note [Printing KindedTyVars]
374 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
375 Trac #3830 reminded me that we should really only print the kind
376 signature on a KindedTyVar if the kind signature was put there by the
377 programmer. During kind inference GHC now adds a PostTcKind to UserTyVars,
378 rather than converting to KindedTyVars as before.
380 (As it happens, the message in #3830 comes out a different way now,
381 and the problem doesn't show up; but having the flag on a KindedTyVar
382 seems like the Right Thing anyway.)
385 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
386 pREC_TOP = 0 -- type in ParseIface.y
387 pREC_FUN = 1 -- btype in ParseIface.y
388 -- Used for LH arg of (->)
389 pREC_OP = 2 -- Used for arg of any infix operator
390 -- (we don't keep their fixities around)
391 pREC_CON = 3 -- Used for arg of type applicn:
392 -- always parenthesise unless atomic
394 maybeParen :: Int -- Precedence of context
395 -> Int -- Precedence of top-level operator
396 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
397 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
400 -- printing works more-or-less as for Types
402 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
404 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
405 pprParendHsType ty = ppr_mono_ty pREC_CON ty
407 -- Before printing a type
408 -- (a) Remove outermost HsParTy parens
409 -- (b) Drop top-level for-all type variables in user style
410 -- since they are implicit in Haskell
411 prepare :: PprStyle -> HsType name -> HsType name
412 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
415 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
416 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
418 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
419 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
420 = maybeParen ctxt_prec pREC_FUN $
421 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
423 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
424 ppr_mono_ty _ (HsQuasiQuoteTy qq) = ppr qq
425 ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
426 ppr_mono_ty _ (HsTyVar name) = ppr name
427 ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
428 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
429 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
430 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
431 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
432 ppr_mono_ty _ (HsPredTy pred) = ppr pred
433 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
434 ppr_mono_ty _ (HsSpliceTy s _ _) = pprSplice s
436 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
437 = maybeParen ctxt_prec pREC_CON $
438 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
440 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
441 = maybeParen ctxt_prec pREC_OP $
442 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
444 ppr_mono_ty _ (HsParTy ty)
445 = parens (ppr_mono_lty pREC_TOP ty)
446 -- Put the parens in where the user did
447 -- But we still use the precedence stuff to add parens because
448 -- toHsType doesn't put in any HsParTys, so we may still need them
450 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
451 = maybeParen ctxt_prec pREC_OP $
452 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
453 -- we pretty print Haddock comments on types as if they were
456 --------------------------
457 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
458 ppr_fun_ty ctxt_prec ty1 ty2
459 = let p1 = ppr_mono_lty pREC_FUN ty1
460 p2 = ppr_mono_lty pREC_TOP ty2
462 maybeParen ctxt_prec pREC_FUN $
463 sep [p1, ptext (sLit "->") <+> p2]
465 --------------------------
466 pabrackets :: SDoc -> SDoc
467 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")