2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsTypes]{Abstract syntax: user-defined types}
9 HsTyVarBndr(..), LHsTyVarBndr,
11 HsContext, LHsContext,
14 LBangType, BangType, HsBang(..),
15 getBangType, getBangStrictness,
17 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
18 hsTyVarName, hsTyVarNames, replaceTyVarName,
19 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
20 splitHsInstDeclTy, splitHsFunType,
23 PostTcType, placeHolderType,
26 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
29 #include "HsVersions.h"
31 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
34 import {- Kind parts of -}
35 Type ( {- instance Outputable Kind -} Kind,
36 pprParendKind, pprKind, isLiftedTypeKind )
37 import HsDoc ( LHsDoc, HsDoc )
38 import BasicTypes ( IPName, Boxity, tupleParens )
39 import SrcLoc ( Located(..), unLoc, noSrcSpan )
40 import StaticFlags ( opt_PprStyle_Debug )
45 %************************************************************************
47 \subsection{Annotating the syntax}
49 %************************************************************************
52 type PostTcType = Type -- Used for slots in the abstract syntax
53 -- where we want to keep slot for a type
54 -- to be added by the type checker...but
55 -- before typechecking it's just bogus
57 placeHolderType :: PostTcType -- Used before typechecking
58 placeHolderType = panic "Evaluated the place holder for a PostTcType"
61 %************************************************************************
63 \subsection{Bang annotations}
65 %************************************************************************
68 type LBangType name = Located (BangType name)
69 type BangType name = HsType name -- Bangs are in the HsType data type
71 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
72 -- never appears on a HsBangTy
74 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
76 instance Outputable HsBang where
77 ppr (HsNoBang) = empty
78 ppr (HsStrict) = char '!'
79 ppr (HsUnbox) = ptext SLIT("!!")
81 getBangType :: LHsType a -> LHsType a
82 getBangType (L _ (HsBangTy _ ty)) = ty
85 getBangStrictness :: LHsType a -> HsBang
86 getBangStrictness (L _ (HsBangTy s _)) = s
87 getBangStrictness _ = HsNoBang
91 %************************************************************************
93 \subsection{Data types}
95 %************************************************************************
97 This is the syntax for types as seen in type signatures.
100 type LHsContext name = Located (HsContext name)
102 type HsContext name = [LHsPred name]
104 type LHsPred name = Located (HsPred name)
106 data HsPred name = HsClassP name [LHsType name]
107 | HsIParam (IPName name) (LHsType name)
109 type LHsType name = Located (HsType name)
112 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
113 -- the user wrote it originally, so that the printer can
114 -- print it as the user wrote it
115 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
116 -- until the renamer fills in the variables
120 | HsTyVar name -- Type variable or type constructor
122 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
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) (LHsDoc name) -- A documented type
163 data HsExplicitForAll = Explicit | Implicit
165 -----------------------
166 -- Combine adjacent for-alls.
167 -- The following awkward situation can happen otherwise:
168 -- f :: forall a. ((Num a) => Int)
169 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
170 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
171 -- but the export list abstracts f wrt [a]. Disaster.
173 -- A valid type must have one for-all at the top of the type, or of the fn arg types
175 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
176 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
178 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
179 -- Smart constructor for HsForAllTy
180 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
181 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
183 -- mk_forall_ty makes a pure for-all type (no context)
184 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
185 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
186 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
187 -- Even if tvs is empty, we still make a HsForAll!
188 -- In the Implicit case, this signals the place to do implicit quantification
189 -- In the Explicit case, it prevents implicit quantification
190 -- (see the sigtype production in Parser.y.pp)
191 -- so that (forall. ty) isn't implicitly quantified
193 Implicit `plus` Implicit = Implicit
194 exp1 `plus` exp2 = Explicit
196 hsExplicitTvs :: LHsType name -> [name]
197 -- The explicitly-given forall'd type variables of a HsType
198 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
199 hsExplicitTvs other = []
201 ---------------------
202 type LHsTyVarBndr name = Located (HsTyVarBndr name)
204 data HsTyVarBndr name
206 | KindedTyVar name Kind
207 -- *** NOTA BENE *** A "monotype" in a pragma can have
208 -- for-alls in it, (mostly to do with dictionaries). These
209 -- must be explicitly Kinded.
211 hsTyVarName :: HsTyVarBndr name -> name
212 hsTyVarName (UserTyVar n) = n
213 hsTyVarName (KindedTyVar n _) = n
215 hsLTyVarName :: LHsTyVarBndr name -> name
216 hsLTyVarName = hsTyVarName . unLoc
218 hsTyVarNames :: [HsTyVarBndr name] -> [name]
219 hsTyVarNames tvs = map hsTyVarName tvs
221 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
222 hsLTyVarNames = map hsLTyVarName
224 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
225 hsLTyVarLocName = fmap hsTyVarName
227 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
228 hsLTyVarLocNames = map hsLTyVarLocName
230 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
231 replaceTyVarName (UserTyVar n) n' = UserTyVar n'
232 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
238 :: OutputableBndr name
240 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
241 -- Split up an instance decl type, returning the pieces
243 splitHsInstDeclTy inst_ty
245 HsParTy (L _ ty) -> splitHsInstDeclTy ty
246 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
247 other -> split_tau [] [] other
248 -- The type vars should have been computed by now, even if they were implicit
250 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
251 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
252 split_tau _ _ other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
254 -- Splits HsType into the (init, last) parts
255 -- Breaks up any parens in the result type:
256 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
257 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
258 splitHsFunType (L l (HsFunTy x y)) = (x:args, res)
260 (args, res) = splitHsFunType y
261 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
262 splitHsFunType other = ([], other)
266 %************************************************************************
268 \subsection{Pretty printing}
270 %************************************************************************
272 NB: these types get printed into interface files, so
273 don't change the printing format lightly
276 instance (OutputableBndr name) => Outputable (HsType name) where
277 ppr ty = pprHsType ty
279 instance (Outputable name) => Outputable (HsTyVarBndr name) where
280 ppr (UserTyVar name) = ppr name
281 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
283 instance OutputableBndr name => Outputable (HsPred name) where
284 ppr (HsClassP clas tys) = ppr clas <+> hsep (map (pprParendHsType.unLoc) tys)
285 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
287 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
288 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
289 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
291 pprHsForAll exp tvs cxt
292 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
293 | otherwise = pprHsContext (unLoc cxt)
295 show_forall = opt_PprStyle_Debug
296 || (not (null tvs) && is_explicit)
297 is_explicit = case exp of {Explicit -> True; Implicit -> False}
298 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
300 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
301 pprHsContext [] = empty
302 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
304 ppr_hs_context [] = empty
305 ppr_hs_context cxt = parens (interpp'SP cxt)
309 pREC_TOP = (0 :: Int) -- type in ParseIface.y
310 pREC_FUN = (1 :: Int) -- btype in ParseIface.y
311 -- Used for LH arg of (->)
312 pREC_OP = (2 :: Int) -- Used for arg of any infix operator
313 -- (we don't keep their fixities around)
314 pREC_CON = (3 :: Int) -- Used for arg of type applicn:
315 -- always parenthesise unless atomic
317 maybeParen :: Int -- Precedence of context
318 -> Int -- Precedence of top-level operator
319 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
320 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
323 -- printing works more-or-less as for Types
325 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
327 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
328 pprParendHsType ty = ppr_mono_ty pREC_CON ty
330 -- Before printing a type
331 -- (a) Remove outermost HsParTy parens
332 -- (b) Drop top-level for-all type variables in user style
333 -- since they are implicit in Haskell
334 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
337 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
339 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
340 = maybeParen ctxt_prec pREC_FUN $
341 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
344 ppr_mono_ty ctxt_prec (HsBangTy b ty) = ppr b <> ppr ty
345 ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
346 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
347 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
348 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
349 ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
350 ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
351 ppr_mono_ty ctxt_prec (HsPredTy pred) = braces (ppr pred)
352 ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
353 ppr_mono_ty ctxt_prec (HsSpliceTy s) = pprSplice s
355 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
356 = maybeParen ctxt_prec pREC_CON $
357 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
359 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
360 = maybeParen ctxt_prec pREC_OP $
361 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
363 ppr_mono_ty ctxt_prec (HsParTy ty)
364 = parens (ppr_mono_lty pREC_TOP ty)
365 -- Put the parens in where the user did
366 -- But we still use the precedence stuff to add parens because
367 -- toHsType doesn't put in any HsParTys, so we may still need them
369 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
370 = ppr ty <+> ppr (unLoc doc)
372 --------------------------
373 ppr_fun_ty ctxt_prec ty1 ty2
374 = let p1 = ppr_mono_lty pREC_FUN ty1
375 p2 = ppr_mono_lty pREC_TOP ty2
377 maybeParen ctxt_prec pREC_FUN $
378 sep [p1, ptext SLIT("->") <+> p2]
380 --------------------------
381 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")