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 mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
20 hsTyVarName, hsTyVarNames, replaceTyVarName,
21 hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
22 splitHsInstDeclTy, splitHsFunType,
25 PostTcType, placeHolderType,
28 pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
31 #include "HsVersions.h"
33 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
44 %************************************************************************
46 \subsection{Annotating the syntax}
48 %************************************************************************
51 type PostTcType = Type -- Used for slots in the abstract syntax
52 -- where we want to keep slot for a type
53 -- to be added by the type checker...but
54 -- before typechecking it's just bogus
56 placeHolderType :: PostTcType -- Used before typechecking
57 placeHolderType = panic "Evaluated the place holder for a PostTcType"
60 %************************************************************************
62 \subsection{Bang annotations}
64 %************************************************************************
67 type LBangType name = Located (BangType name)
68 type BangType name = HsType name -- Bangs are in the HsType data type
70 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
71 -- never appears on a HsBangTy
73 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
75 instance Outputable HsBang where
76 ppr (HsNoBang) = empty
77 ppr (HsStrict) = char '!'
78 ppr (HsUnbox) = ptext SLIT("!!")
80 getBangType :: LHsType a -> LHsType a
81 getBangType (L _ (HsBangTy _ ty)) = ty
84 getBangStrictness :: LHsType a -> HsBang
85 getBangStrictness (L _ (HsBangTy s _)) = s
86 getBangStrictness _ = HsNoBang
90 %************************************************************************
92 \subsection{Data types}
94 %************************************************************************
96 This is the syntax for types as seen in type signatures.
99 type LHsContext name = Located (HsContext name)
101 type HsContext name = [LHsPred name]
103 type LHsPred name = Located (HsPred name)
105 data HsPred name = HsClassP name [LHsType name] -- class constraint
106 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
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 %************************************************************************
273 instance (OutputableBndr name) => Outputable (HsType name) where
274 ppr ty = pprHsType ty
276 instance (Outputable name) => Outputable (HsTyVarBndr name) where
277 ppr (UserTyVar name) = ppr name
278 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
280 instance OutputableBndr name => Outputable (HsPred name) where
281 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
282 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext SLIT("~"),
284 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
286 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
287 pprLHsType = pprParendHsType . unLoc
289 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
290 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
291 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
293 pprHsForAll exp tvs cxt
294 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
295 | otherwise = pprHsContext (unLoc cxt)
297 show_forall = opt_PprStyle_Debug
298 || (not (null tvs) && is_explicit)
299 is_explicit = case exp of {Explicit -> True; Implicit -> False}
300 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
302 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
303 pprHsContext [] = empty
304 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
306 ppr_hs_context [] = empty
307 ppr_hs_context cxt = parens (interpp'SP cxt)
311 pREC_TOP = (0 :: Int) -- type in ParseIface.y
312 pREC_FUN = (1 :: Int) -- btype in ParseIface.y
313 -- Used for LH arg of (->)
314 pREC_OP = (2 :: Int) -- Used for arg of any infix operator
315 -- (we don't keep their fixities around)
316 pREC_CON = (3 :: Int) -- Used for arg of type applicn:
317 -- always parenthesise unless atomic
319 maybeParen :: Int -- Precedence of context
320 -> Int -- Precedence of top-level operator
321 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
322 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
325 -- printing works more-or-less as for Types
327 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
329 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
330 pprParendHsType ty = ppr_mono_ty pREC_CON ty
332 -- Before printing a type
333 -- (a) Remove outermost HsParTy parens
334 -- (b) Drop top-level for-all type variables in user style
335 -- since they are implicit in Haskell
336 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
339 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
341 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
342 = maybeParen ctxt_prec pREC_FUN $
343 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
345 ppr_mono_ty ctxt_prec (HsBangTy b ty) = ppr b <> ppr ty
346 ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
347 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
348 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
349 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
350 ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
351 ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
352 ppr_mono_ty ctxt_prec (HsPredTy pred) = ppr pred
353 ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
354 ppr_mono_ty ctxt_prec (HsSpliceTy s) = pprSplice s
356 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
357 = maybeParen ctxt_prec pREC_CON $
358 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
360 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
361 = maybeParen ctxt_prec pREC_OP $
362 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
364 ppr_mono_ty ctxt_prec (HsParTy ty)
365 = parens (ppr_mono_lty pREC_TOP ty)
366 -- Put the parens in where the user did
367 -- But we still use the precedence stuff to add parens because
368 -- toHsType doesn't put in any HsParTys, so we may still need them
370 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
371 = ppr ty <+> ppr (unLoc doc)
373 --------------------------
374 ppr_fun_ty ctxt_prec ty1 ty2
375 = let p1 = ppr_mono_lty pREC_FUN ty1
376 p2 = ppr_mono_lty pREC_TOP ty2
378 maybeParen ctxt_prec pREC_FUN $
379 sep [p1, ptext SLIT("->") <+> p2]
381 --------------------------
382 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")