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,
16 LBangType, BangType, HsBang(..),
17 getBangType, getBangStrictness,
19 ConDeclField(..), pprConDeclFields,
21 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
22 hsTyVarName, hsTyVarNames, replaceTyVarName,
23 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
24 splitHsInstDeclTy, splitHsFunType,
27 PostTcType, placeHolderType,
30 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
33 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
46 %************************************************************************
48 \subsection{Annotating the syntax}
50 %************************************************************************
53 type PostTcType = Type -- Used for slots in the abstract syntax
54 -- where we want to keep slot for a type
55 -- to be added by the type checker...but
56 -- before typechecking it's just bogus
58 placeHolderType :: PostTcType -- Used before typechecking
59 placeHolderType = panic "Evaluated the place holder for a PostTcType"
62 %************************************************************************
64 \subsection{Bang annotations}
66 %************************************************************************
69 type LBangType name = Located (BangType name)
70 type BangType name = HsType name -- Bangs are in the HsType data type
72 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
73 -- never appears on a HsBangTy
75 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
77 instance Outputable HsBang where
78 ppr (HsNoBang) = empty
79 ppr (HsStrict) = char '!'
80 ppr (HsUnbox) = ptext (sLit "!!")
82 getBangType :: LHsType a -> LHsType a
83 getBangType (L _ (HsBangTy _ ty)) = ty
86 getBangStrictness :: LHsType a -> HsBang
87 getBangStrictness (L _ (HsBangTy s _)) = s
88 getBangStrictness _ = HsNoBang
92 %************************************************************************
94 \subsection{Data types}
96 %************************************************************************
98 This is the syntax for types as seen in type signatures.
101 type LHsContext name = Located (HsContext name)
103 type HsContext name = [LHsPred name]
105 type LHsPred name = Located (HsPred name)
107 data HsPred name = HsClassP name [LHsType name] -- class constraint
108 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
109 | HsIParam (IPName name) (LHsType name)
111 type LHsType name = Located (HsType name)
114 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
115 -- the user wrote it originally, so that the printer can
116 -- print it as the user wrote it
117 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
118 -- until the renamer fills in the variables
122 | HsTyVar name -- Type variable or type constructor
124 | HsAppTy (LHsType name)
127 | HsFunTy (LHsType name) -- function type
130 | HsListTy (LHsType name) -- Element type
132 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
135 [LHsType name] -- Element types (length gives arity)
137 | HsOpTy (LHsType name) (Located name) (LHsType name)
139 | HsParTy (LHsType name)
140 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
141 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
143 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
144 -- interface files smaller), so when printing a HsType we may need to
147 | HsNumTy Integer -- Generics only
149 | HsPredTy (HsPred name) -- Only used in the type of an instance
150 -- declaration, eg. Eq [a] -> Eq a
153 -- Note no need for location info on the
154 -- enclosed HsPred; the one on the type will do
156 | HsKindSig (LHsType name) -- (ty :: kind)
157 Kind -- A type with a kind signature
159 | HsSpliceTy (HsSplice name)
161 | HsDocTy (LHsType name) LHsDocString -- A documented type
163 | HsSpliceTyOut Kind -- Used just like KindedTyVar, just between
164 -- kcHsType and dsHsType
166 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
167 | HsRecTy [ConDeclField name] -- Only in data type declarations
169 data HsExplicitForAll = Explicit | Implicit
173 data ConDeclField name -- Record fields have Haddoc docs on them
174 = ConDeclField { cd_fld_name :: Located name,
175 cd_fld_type :: LBangType name,
176 cd_fld_doc :: Maybe LHsDocString }
179 -----------------------
180 -- Combine adjacent for-alls.
181 -- The following awkward situation can happen otherwise:
182 -- f :: forall a. ((Num a) => Int)
183 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
184 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
185 -- but the export list abstracts f wrt [a]. Disaster.
187 -- A valid type must have one for-all at the top of the type, or of the fn arg types
189 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
190 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
191 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
192 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
194 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
195 -- Smart constructor for HsForAllTy
196 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
197 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
199 -- mk_forall_ty makes a pure for-all type (no context)
200 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
201 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
202 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
203 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
204 -- Even if tvs is empty, we still make a HsForAll!
205 -- In the Implicit case, this signals the place to do implicit quantification
206 -- In the Explicit case, it prevents implicit quantification
207 -- (see the sigtype production in Parser.y.pp)
208 -- so that (forall. ty) isn't implicitly quantified
210 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
211 Implicit `plus` Implicit = Implicit
212 _ `plus` _ = Explicit
214 hsExplicitTvs :: LHsType name -> [name]
215 -- The explicitly-given forall'd type variables of a HsType
216 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
219 ---------------------
220 type LHsTyVarBndr name = Located (HsTyVarBndr name)
222 data HsTyVarBndr name
224 | KindedTyVar name Kind
225 -- *** NOTA BENE *** A "monotype" in a pragma can have
226 -- for-alls in it, (mostly to do with dictionaries). These
227 -- must be explicitly Kinded.
229 hsTyVarName :: HsTyVarBndr name -> name
230 hsTyVarName (UserTyVar n) = n
231 hsTyVarName (KindedTyVar n _) = n
233 hsLTyVarName :: LHsTyVarBndr name -> name
234 hsLTyVarName = hsTyVarName . unLoc
236 hsTyVarNames :: [HsTyVarBndr name] -> [name]
237 hsTyVarNames tvs = map hsTyVarName tvs
239 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
240 hsLTyVarNames = map hsLTyVarName
242 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
243 hsLTyVarLocName = fmap hsTyVarName
245 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
246 hsLTyVarLocNames = map hsLTyVarLocName
248 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
249 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
250 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
256 :: OutputableBndr name
258 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
259 -- Split up an instance decl type, returning the pieces
261 splitHsInstDeclTy inst_ty
263 HsParTy (L _ ty) -> splitHsInstDeclTy ty
264 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
265 other -> split_tau [] [] other
266 -- The type vars should have been computed by now, even if they were implicit
268 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
269 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
270 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
272 -- Splits HsType into the (init, last) parts
273 -- Breaks up any parens in the result type:
274 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
275 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
276 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
278 (args, res) = splitHsFunType y
279 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
280 splitHsFunType other = ([], other)
284 %************************************************************************
286 \subsection{Pretty printing}
288 %************************************************************************
291 instance (OutputableBndr name) => Outputable (HsType name) where
292 ppr ty = pprHsType ty
294 instance (Outputable name) => Outputable (HsTyVarBndr name) where
295 ppr (UserTyVar name) = ppr name
296 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
298 instance OutputableBndr name => Outputable (HsPred name) where
299 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
300 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
302 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
304 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
305 pprLHsType = pprParendHsType . unLoc
307 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
308 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
309 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
311 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
312 pprHsForAll exp tvs cxt
313 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
314 | otherwise = pprHsContext (unLoc cxt)
316 show_forall = opt_PprStyle_Debug
317 || (not (null tvs) && is_explicit)
318 is_explicit = case exp of {Explicit -> True; Implicit -> False}
319 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
321 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
322 pprHsContext [] = empty
323 pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
325 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
326 ppr_hs_context [] = empty
327 ppr_hs_context cxt = parens (interpp'SP cxt)
329 pprConDeclFields :: OutputableBndr name => [ConDeclField name] -> SDoc
330 pprConDeclFields fields = braces (sep (punctuate comma (map ppr_fld fields)))
332 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
334 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
338 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
339 pREC_TOP = 0 -- type in ParseIface.y
340 pREC_FUN = 1 -- btype in ParseIface.y
341 -- Used for LH arg of (->)
342 pREC_OP = 2 -- Used for arg of any infix operator
343 -- (we don't keep their fixities around)
344 pREC_CON = 3 -- Used for arg of type applicn:
345 -- always parenthesise unless atomic
347 maybeParen :: Int -- Precedence of context
348 -> Int -- Precedence of top-level operator
349 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
350 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
353 -- printing works more-or-less as for Types
355 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
357 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
358 pprParendHsType ty = ppr_mono_ty pREC_CON ty
360 -- Before printing a type
361 -- (a) Remove outermost HsParTy parens
362 -- (b) Drop top-level for-all type variables in user style
363 -- since they are implicit in Haskell
364 prepare :: PprStyle -> HsType name -> HsType name
365 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
368 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
369 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
371 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
372 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
373 = maybeParen ctxt_prec pREC_FUN $
374 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
376 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
377 ppr_mono_ty _ (HsRecTy flds) = pprConDeclFields flds
378 ppr_mono_ty _ (HsTyVar name) = ppr name
379 ppr_mono_ty prec (HsFunTy ty1 ty2) = ppr_fun_ty prec ty1 ty2
380 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
381 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
382 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
383 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
384 ppr_mono_ty _ (HsPredTy pred) = ppr pred
385 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
386 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
387 ppr_mono_ty _ (HsSpliceTyOut k) = text "<splicety>" <> dcolon <> ppr k
389 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
390 = maybeParen ctxt_prec pREC_CON $
391 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
393 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
394 = maybeParen ctxt_prec pREC_OP $
395 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
397 ppr_mono_ty _ (HsParTy ty)
398 = parens (ppr_mono_lty pREC_TOP ty)
399 -- Put the parens in where the user did
400 -- But we still use the precedence stuff to add parens because
401 -- toHsType doesn't put in any HsParTys, so we may still need them
403 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
404 = maybeParen ctxt_prec pREC_OP $
405 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
406 -- we pretty print Haddock comments on types as if they were
409 --------------------------
410 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
411 ppr_fun_ty ctxt_prec ty1 ty2
412 = let p1 = ppr_mono_lty pREC_FUN ty1
413 p2 = ppr_mono_lty pREC_TOP ty2
415 maybeParen ctxt_prec pREC_FUN $
416 sep [p1, ptext (sLit "->") <+> p2]
418 --------------------------
419 pabrackets :: SDoc -> SDoc
420 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")