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 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
25 splitHsInstDeclTy, splitHsFunType,
28 PostTcType, placeHolderType,
31 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
34 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
47 %************************************************************************
49 \subsection{Annotating the syntax}
51 %************************************************************************
54 type PostTcType = Type -- Used for slots in the abstract syntax
55 -- where we want to keep slot for a type
56 -- to be added by the type checker...but
57 -- before typechecking it's just bogus
59 placeHolderType :: PostTcType -- Used before typechecking
60 placeHolderType = panic "Evaluated the place holder for a PostTcType"
63 %************************************************************************
65 Quasi quotes; used in types and elsewhere
67 %************************************************************************
70 data HsQuasiQuote id = HsQuasiQuote
71 id -- The quasi-quoter
72 SrcSpan -- The span of the enclosed string
73 FastString -- The enclosed string
75 instance OutputableBndr id => Outputable (HsQuasiQuote id) where
78 ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
79 ppr_qq (HsQuasiQuote quoter _ quote) =
80 char '[' <> ppr quoter <> ptext (sLit "|") <>
81 ppr quote <> ptext (sLit "|]")
85 %************************************************************************
87 \subsection{Bang annotations}
89 %************************************************************************
92 type LBangType name = Located (BangType name)
93 type BangType name = HsType name -- Bangs are in the HsType data type
95 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
96 -- never appears on a HsBangTy
98 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
100 instance Outputable HsBang where
101 ppr (HsNoBang) = empty
102 ppr (HsStrict) = char '!'
103 ppr (HsUnbox) = ptext (sLit "!!")
105 getBangType :: LHsType a -> LHsType a
106 getBangType (L _ (HsBangTy _ ty)) = ty
109 getBangStrictness :: LHsType a -> HsBang
110 getBangStrictness (L _ (HsBangTy s _)) = s
111 getBangStrictness _ = HsNoBang
115 %************************************************************************
117 \subsection{Data types}
119 %************************************************************************
121 This is the syntax for types as seen in type signatures.
124 type LHsContext name = Located (HsContext name)
126 type HsContext name = [LHsPred name]
128 type LHsPred name = Located (HsPred name)
130 data HsPred name = HsClassP name [LHsType name] -- class constraint
131 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
132 | HsIParam (IPName name) (LHsType name)
134 type LHsType name = Located (HsType name)
137 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
138 -- the user wrote it originally, so that the printer can
139 -- print it as the user wrote it
140 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
141 -- until the renamer fills in the variables
145 | HsTyVar name -- Type variable or type constructor
147 | HsAppTy (LHsType name)
150 | HsFunTy (LHsType name) -- function type
153 | HsListTy (LHsType name) -- Element type
155 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
158 [LHsType name] -- Element types (length gives arity)
160 | HsOpTy (LHsType name) (Located name) (LHsType name)
162 | HsParTy (LHsType name)
163 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
164 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
166 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
167 -- interface files smaller), so when printing a HsType we may need to
170 | HsNumTy Integer -- Generics only
172 | HsPredTy (HsPred name) -- Only used in the type of an instance
173 -- declaration, eg. Eq [a] -> Eq a
176 -- Note no need for location info on the
177 -- enclosed HsPred; the one on the type will do
179 | HsKindSig (LHsType name) -- (ty :: kind)
180 Kind -- A type with a kind signature
182 | HsSpliceTy (HsSplice name)
183 | HsQuasiQuoteTy (HsQuasiQuote name)
185 | HsDocTy (LHsType name) LHsDocString -- A documented type
187 | HsSpliceTyOut Kind -- Used just like KindedTyVar, just between
188 -- kcHsType and dsHsType
190 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
191 | HsRecTy [ConDeclField name] -- Only in data type declarations
193 data HsExplicitForAll = Explicit | Implicit
197 data ConDeclField name -- Record fields have Haddoc docs on them
198 = ConDeclField { cd_fld_name :: Located name,
199 cd_fld_type :: LBangType name,
200 cd_fld_doc :: Maybe LHsDocString }
203 -----------------------
204 -- Combine adjacent for-alls.
205 -- The following awkward situation can happen otherwise:
206 -- f :: forall a. ((Num a) => Int)
207 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
208 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
209 -- but the export list abstracts f wrt [a]. Disaster.
211 -- A valid type must have one for-all at the top of the type, or of the fn arg types
213 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
214 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
215 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
216 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
218 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
219 -- Smart constructor for HsForAllTy
220 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
221 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
223 -- mk_forall_ty makes a pure for-all type (no context)
224 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
225 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
226 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
227 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
228 -- Even if tvs is empty, we still make a HsForAll!
229 -- In the Implicit case, this signals the place to do implicit quantification
230 -- In the Explicit case, it prevents implicit quantification
231 -- (see the sigtype production in Parser.y.pp)
232 -- so that (forall. ty) isn't implicitly quantified
234 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
235 Implicit `plus` Implicit = Implicit
236 _ `plus` _ = Explicit
238 hsExplicitTvs :: LHsType name -> [name]
239 -- The explicitly-given forall'd type variables of a HsType
240 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
243 ---------------------
244 type LHsTyVarBndr name = Located (HsTyVarBndr name)
246 data HsTyVarBndr name
248 | KindedTyVar name Kind
249 -- *** NOTA BENE *** A "monotype" in a pragma can have
250 -- for-alls in it, (mostly to do with dictionaries). These
251 -- must be explicitly Kinded.
253 hsTyVarName :: HsTyVarBndr name -> name
254 hsTyVarName (UserTyVar n) = n
255 hsTyVarName (KindedTyVar n _) = n
257 hsLTyVarName :: LHsTyVarBndr name -> name
258 hsLTyVarName = hsTyVarName . unLoc
260 hsTyVarNames :: [HsTyVarBndr name] -> [name]
261 hsTyVarNames tvs = map hsTyVarName tvs
263 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
264 hsLTyVarNames = map hsLTyVarName
266 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
267 hsLTyVarLocName = fmap hsTyVarName
269 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
270 hsLTyVarLocNames = map hsLTyVarLocName
272 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
273 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
274 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
280 :: OutputableBndr name
282 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
283 -- Split up an instance decl type, returning the pieces
285 splitHsInstDeclTy inst_ty
287 HsParTy (L _ ty) -> splitHsInstDeclTy ty
288 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
289 other -> split_tau [] [] other
290 -- The type vars should have been computed by now, even if they were implicit
292 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
293 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
294 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
296 -- Splits HsType into the (init, last) parts
297 -- Breaks up any parens in the result type:
298 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
299 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
300 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
302 (args, res) = splitHsFunType y
303 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
304 splitHsFunType other = ([], other)
308 %************************************************************************
310 \subsection{Pretty printing}
312 %************************************************************************
315 instance (OutputableBndr name) => Outputable (HsType name) where
316 ppr ty = pprHsType ty
318 instance (Outputable name) => Outputable (HsTyVarBndr name) where
319 ppr (UserTyVar name) = ppr name
320 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
322 instance OutputableBndr name => Outputable (HsPred name) where
323 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
324 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
326 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
328 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
329 pprLHsType = pprParendHsType . unLoc
331 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
332 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
333 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
335 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
336 pprHsForAll exp tvs cxt
337 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
338 | otherwise = pprHsContext (unLoc cxt)
340 show_forall = opt_PprStyle_Debug
341 || (not (null tvs) && is_explicit)
342 is_explicit = case exp of {Explicit -> True; Implicit -> False}
343 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
345 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
346 pprHsContext [] = empty
347 pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
349 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
350 ppr_hs_context [] = empty
351 ppr_hs_context cxt = parens (interpp'SP cxt)
353 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
354 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
356 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
358 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
362 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
363 pREC_TOP = 0 -- type in ParseIface.y
364 pREC_FUN = 1 -- btype in ParseIface.y
365 -- Used for LH arg of (->)
366 pREC_OP = 2 -- Used for arg of any infix operator
367 -- (we don't keep their fixities around)
368 pREC_CON = 3 -- Used for arg of type applicn:
369 -- always parenthesise unless atomic
371 maybeParen :: Int -- Precedence of context
372 -> Int -- Precedence of top-level operator
373 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
374 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
377 -- printing works more-or-less as for Types
379 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
381 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
382 pprParendHsType ty = ppr_mono_ty pREC_CON ty
384 -- Before printing a type
385 -- (a) Remove outermost HsParTy parens
386 -- (b) Drop top-level for-all type variables in user style
387 -- since they are implicit in Haskell
388 prepare :: PprStyle -> HsType name -> HsType name
389 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
392 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
393 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
395 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
396 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
397 = maybeParen ctxt_prec pREC_FUN $
398 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
400 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
401 ppr_mono_ty _ (HsQuasiQuoteTy qq) = ppr qq
402 ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
403 ppr_mono_ty _ (HsTyVar name) = ppr name
404 ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
405 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
406 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
407 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
408 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
409 ppr_mono_ty _ (HsPredTy pred) = ppr pred
410 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
411 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
412 ppr_mono_ty _ (HsSpliceTyOut k) = text "<splicety>" <> dcolon <> ppr k
414 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
415 = maybeParen ctxt_prec pREC_CON $
416 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
418 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
419 = maybeParen ctxt_prec pREC_OP $
420 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
422 ppr_mono_ty _ (HsParTy ty)
423 = parens (ppr_mono_lty pREC_TOP ty)
424 -- Put the parens in where the user did
425 -- But we still use the precedence stuff to add parens because
426 -- toHsType doesn't put in any HsParTys, so we may still need them
428 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
429 = maybeParen ctxt_prec pREC_OP $
430 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
431 -- we pretty print Haddock comments on types as if they were
434 --------------------------
435 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
436 ppr_fun_ty ctxt_prec ty1 ty2
437 = let p1 = ppr_mono_lty pREC_FUN ty1
438 p2 = ppr_mono_lty pREC_TOP ty2
440 maybeParen ctxt_prec pREC_FUN $
441 sep [p1, ptext (sLit "->") <+> p2]
443 --------------------------
444 pabrackets :: SDoc -> SDoc
445 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")