2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 HsTypes: Abstract syntax: user-defined types
9 {-# LANGUAGE DeriveDataTypeable #-}
13 HsTyVarBndr(..), LHsTyVarBndr,
15 HsContext, LHsContext,
19 LBangType, BangType, HsBang(..),
20 getBangType, getBangStrictness,
22 ConDeclField(..), pprConDeclFields,
24 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
25 hsTyVarName, hsTyVarNames, replaceTyVarName,
26 hsTyVarKind, hsTyVarNameKind,
27 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
28 splitHsInstDeclTy, splitHsFunType,
29 splitHsAppTys, mkHsAppTys,
32 PostTcType, placeHolderType, PostTcKind, placeHolderKind,
35 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context,
38 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
40 import NameSet( FreeVars )
53 %************************************************************************
55 \subsection{Annotating the syntax}
57 %************************************************************************
60 type PostTcKind = Kind
61 type PostTcType = Type -- Used for slots in the abstract syntax
62 -- where we want to keep slot for a type
63 -- to be added by the type checker...but
64 -- before typechecking it's just bogus
66 placeHolderType :: PostTcType -- Used before typechecking
67 placeHolderType = panic "Evaluated the place holder for a PostTcType"
69 placeHolderKind :: PostTcKind -- Used before typechecking
70 placeHolderKind = panic "Evaluated the place holder for a PostTcKind"
73 %************************************************************************
75 Quasi quotes; used in types and elsewhere
77 %************************************************************************
80 data HsQuasiQuote id = HsQuasiQuote
81 id -- The quasi-quoter
82 SrcSpan -- The span of the enclosed string
83 FastString -- The enclosed string
84 deriving (Data, Typeable)
86 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
89 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
90 ppr_qq (HsQuasiQuote quoter _ quote) =
91 char '[' <> ppr quoter <> ptext (sLit "|") <>
92 ppr quote <> ptext (sLit "|]")
96 %************************************************************************
98 \subsection{Bang annotations}
100 %************************************************************************
103 type LBangType name = Located (BangType name)
104 type BangType name = HsType name -- Bangs are in the HsType data type
106 getBangType :: LHsType a -> LHsType a
107 getBangType (L _ (HsBangTy _ ty)) = ty
110 getBangStrictness :: LHsType a -> HsBang
111 getBangStrictness (L _ (HsBangTy s _)) = s
112 getBangStrictness _ = HsNoBang
116 %************************************************************************
118 \subsection{Data types}
120 %************************************************************************
122 This is the syntax for types as seen in type signatures.
125 type LHsContext name = Located (HsContext name)
127 type HsContext name = [LHsPred name]
129 type LHsPred name = Located (HsPred name)
131 data HsPred name = HsClassP name [LHsType name] -- class constraint
132 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
133 | HsIParam (IPName name) (LHsType name)
134 deriving (Data, Typeable)
136 type LHsType name = Located (HsType name)
139 = HsForAllTy HsExplicitFlag -- Renamer leaves this flag unchanged, to record the way
140 -- the user wrote it originally, so that the printer can
141 -- print it as the user wrote it
142 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
143 -- until the renamer fills in the variables
147 | HsTyVar name -- Type variable or type constructor
149 | HsAppTy (LHsType name)
152 | HsFunTy (LHsType name) -- function type
155 | HsKappaTy (LHsType name) -- first-order function type
158 | HsListTy (LHsType name) -- Element type
160 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
162 | HsModalBoxType name (LHsType name) -- modal types; first argument is the environment classifier
165 [LHsType name] -- Element types (length gives arity)
167 | HsOpTy (LHsType name) (Located name) (LHsType name)
169 | HsParTy (LHsType name)
170 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
171 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
173 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
174 -- interface files smaller), so when printing a HsType we may need to
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 | HsCoreTy Type -- An escape hatch for tunnelling a *closed*
199 -- Core Type through HsSyn.
201 deriving (Data, Typeable)
203 data HsExplicitFlag = Explicit | Implicit deriving (Data, Typeable)
205 data ConDeclField name -- Record fields have Haddoc docs on them
206 = ConDeclField { cd_fld_name :: Located name,
207 cd_fld_type :: LBangType name,
208 cd_fld_doc :: Maybe LHsDocString }
209 deriving (Data, Typeable)
211 -----------------------
212 -- Combine adjacent for-alls.
213 -- The following awkward situation can happen otherwise:
214 -- f :: forall a. ((Num a) => Int)
215 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
216 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
217 -- but the export list abstracts f wrt [a]. Disaster.
219 -- A valid type must have one for-all at the top of the type, or of the fn arg types
221 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
222 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
223 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
224 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
226 mkHsForAllTy :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
227 -- Smart constructor for HsForAllTy
228 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
229 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
231 -- mk_forall_ty makes a pure for-all type (no context)
232 mk_forall_ty :: HsExplicitFlag -> [LHsTyVarBndr name] -> LHsType name -> HsType name
233 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
234 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
235 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
236 -- Even if tvs is empty, we still make a HsForAll!
237 -- In the Implicit case, this signals the place to do implicit quantification
238 -- In the Explicit case, it prevents implicit quantification
239 -- (see the sigtype production in Parser.y.pp)
240 -- so that (forall. ty) isn't implicitly quantified
242 plus :: HsExplicitFlag -> HsExplicitFlag -> HsExplicitFlag
243 Implicit `plus` Implicit = Implicit
244 _ `plus` _ = Explicit
246 hsExplicitTvs :: LHsType name -> [name]
247 -- The explicitly-given forall'd type variables of a HsType
248 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
251 ---------------------
252 type LHsTyVarBndr name = Located (HsTyVarBndr name)
254 data HsTyVarBndr name
255 = UserTyVar -- No explicit kinding
256 name -- See Note [Printing KindedTyVars]
262 -- *** NOTA BENE *** A "monotype" in a pragma can have
263 -- for-alls in it, (mostly to do with dictionaries). These
264 -- must be explicitly Kinded.
265 deriving (Data, Typeable)
267 hsTyVarName :: HsTyVarBndr name -> name
268 hsTyVarName (UserTyVar n _) = n
269 hsTyVarName (KindedTyVar n _) = n
271 hsTyVarKind :: HsTyVarBndr name -> Kind
272 hsTyVarKind (UserTyVar _ k) = k
273 hsTyVarKind (KindedTyVar _ k) = k
275 hsTyVarNameKind :: HsTyVarBndr name -> (name, Kind)
276 hsTyVarNameKind (UserTyVar n k) = (n,k)
277 hsTyVarNameKind (KindedTyVar n k) = (n,k)
279 hsLTyVarName :: LHsTyVarBndr name -> name
280 hsLTyVarName = hsTyVarName . unLoc
282 hsTyVarNames :: [HsTyVarBndr name] -> [name]
283 hsTyVarNames tvs = map hsTyVarName tvs
285 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
286 hsLTyVarNames = map hsLTyVarName
288 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
289 hsLTyVarLocName = fmap hsTyVarName
291 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
292 hsLTyVarLocNames = map hsLTyVarLocName
294 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
295 replaceTyVarName (UserTyVar _ k) n' = UserTyVar n' k
296 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
301 splitHsAppTys :: LHsType n -> [LHsType n] -> (LHsType n, [LHsType n])
302 splitHsAppTys (L _ (HsAppTy f a)) as = splitHsAppTys f (a:as)
303 splitHsAppTys f as = (f,as)
305 mkHsAppTys :: OutputableBndr n => LHsType n -> [LHsType n] -> HsType n
306 mkHsAppTys fun_ty [] = pprPanic "mkHsAppTys" (ppr fun_ty)
307 mkHsAppTys fun_ty (arg_ty:arg_tys)
308 = foldl mk_app (HsAppTy fun_ty arg_ty) arg_tys
310 mk_app fun arg = HsAppTy (noLoc fun) arg
311 -- Add noLocs for inner nodes of the application;
312 -- they are never used
315 :: OutputableBndr name
317 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
318 -- Split up an instance decl type, returning the pieces
320 splitHsInstDeclTy inst_ty
322 HsParTy (L _ ty) -> splitHsInstDeclTy ty
323 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
324 other -> split_tau [] [] other
325 -- The type vars should have been computed by now, even if they were implicit
327 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
328 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
329 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
331 -- Splits HsType into the (init, last) parts
332 -- Breaks up any parens in the result type:
333 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
334 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
335 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
337 (args, res) = splitHsFunType y
338 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
339 splitHsFunType other = ([], other)
343 %************************************************************************
345 \subsection{Pretty printing}
347 %************************************************************************
350 instance (OutputableBndr name) => Outputable (HsType name) where
351 ppr ty = pprHsType ty
353 instance (Outputable name) => Outputable (HsTyVarBndr name) where
354 ppr (UserTyVar name _) = ppr name
355 ppr (KindedTyVar name kind) = hsep [ppr name, dcolon, pprParendKind kind]
357 instance OutputableBndr name => Outputable (HsPred name) where
358 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
359 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
361 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
363 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
364 pprLHsType = pprParendHsType . unLoc
366 pprHsForAll :: OutputableBndr name => HsExplicitFlag -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
367 pprHsForAll exp tvs cxt
368 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
369 | otherwise = pprHsContext (unLoc cxt)
371 show_forall = opt_PprStyle_Debug
372 || (not (null tvs) && is_explicit)
373 is_explicit = case exp of {Explicit -> True; Implicit -> False}
374 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
376 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
377 pprHsContext [] = empty
378 pprHsContext [L _ pred]
379 | noParenHsPred pred = ppr pred <+> darrow
380 pprHsContext cxt = ppr_hs_context cxt <+> darrow
382 noParenHsPred :: HsPred name -> Bool
383 -- c.f. TypeRep.noParenPred
384 noParenHsPred (HsClassP {}) = True
385 noParenHsPred (HsEqualP {}) = True
386 noParenHsPred (HsIParam {}) = False
388 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
389 ppr_hs_context [] = empty
390 ppr_hs_context cxt = parens (interpp'SP cxt)
392 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
393 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
395 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
397 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
400 Note [Printing KindedTyVars]
401 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
402 Trac #3830 reminded me that we should really only print the kind
403 signature on a KindedTyVar if the kind signature was put there by the
404 programmer. During kind inference GHC now adds a PostTcKind to UserTyVars,
405 rather than converting to KindedTyVars as before.
407 (As it happens, the message in #3830 comes out a different way now,
408 and the problem doesn't show up; but having the flag on a KindedTyVar
409 seems like the Right Thing anyway.)
412 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
413 pREC_TOP = 0 -- type in ParseIface.y
414 pREC_FUN = 1 -- btype in ParseIface.y
415 -- Used for LH arg of (->)
416 pREC_OP = 2 -- Used for arg of any infix operator
417 -- (we don't keep their fixities around)
418 pREC_CON = 3 -- Used for arg of type applicn:
419 -- always parenthesise unless atomic
421 maybeParen :: Int -- Precedence of context
422 -> Int -- Precedence of top-level operator
423 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
424 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
427 -- printing works more-or-less as for Types
429 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
431 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
432 pprParendHsType ty = ppr_mono_ty pREC_CON ty
434 -- Before printing a type
435 -- (a) Remove outermost HsParTy parens
436 -- (b) Drop top-level for-all type variables in user style
437 -- since they are implicit in Haskell
438 prepare :: PprStyle -> HsType name -> HsType name
439 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
442 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
443 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
445 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
446 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
447 = maybeParen ctxt_prec pREC_FUN $
448 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
450 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
451 ppr_mono_ty _ (HsQuasiQuoteTy qq) = ppr qq
452 ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
453 ppr_mono_ty _ (HsTyVar name) = ppr name
454 ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
455 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
456 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
457 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
458 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
459 ppr_mono_ty prec (HsKappaTy ty1 ty2) = ppr_kappa_ty prec ty1 ty2
460 ppr_mono_ty _ (HsModalBoxType ecn ty) = ppr_modalBoxType (ppr ecn) (ppr_mono_lty pREC_TOP ty)
461 ppr_mono_ty _ (HsPredTy pred) = ppr pred
462 ppr_mono_ty _ (HsSpliceTy s _ _) = pprSplice s
463 ppr_mono_ty _ (HsCoreTy ty) = ppr ty
465 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
466 = maybeParen ctxt_prec pREC_CON $
467 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
469 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
470 = maybeParen ctxt_prec pREC_OP $
471 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
473 ppr_mono_ty _ (HsParTy ty)
474 = parens (ppr_mono_lty pREC_TOP ty)
475 -- Put the parens in where the user did
476 -- But we still use the precedence stuff to add parens because
477 -- toHsType doesn't put in any HsParTys, so we may still need them
479 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
480 = maybeParen ctxt_prec pREC_OP $
481 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
482 -- we pretty print Haddock comments on types as if they were
485 --------------------------
486 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
487 ppr_fun_ty ctxt_prec ty1 ty2
488 = let p1 = ppr_mono_lty pREC_FUN ty1
489 p2 = ppr_mono_lty pREC_TOP ty2
491 maybeParen ctxt_prec pREC_FUN $
492 sep [p1, ptext (sLit "->") <+> p2]
494 ppr_kappa_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
495 ppr_kappa_ty ctxt_prec ty1 ty2
496 = let p1 = ppr_mono_lty pREC_FUN ty1
497 p2 = ppr_mono_lty pREC_TOP ty2
499 maybeParen ctxt_prec pREC_FUN $
500 sep [p1, ptext (sLit "~~>") <+> p2]
502 --------------------------
503 pabrackets :: SDoc -> SDoc
504 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
506 ppr_modalBoxType :: SDoc -> SDoc -> SDoc
507 ppr_modalBoxType ecn p = ptext (sLit "<[") <> p <> ptext (sLit "]>@") <> ecn