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 :: LHsContext name -> LHsType name -> HsType name
176 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
177 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
178 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
180 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
181 -- Smart constructor for HsForAllTy
182 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
183 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
185 -- mk_forall_ty makes a pure for-all type (no context)
186 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
187 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
188 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
189 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
190 -- Even if tvs is empty, we still make a HsForAll!
191 -- In the Implicit case, this signals the place to do implicit quantification
192 -- In the Explicit case, it prevents implicit quantification
193 -- (see the sigtype production in Parser.y.pp)
194 -- so that (forall. ty) isn't implicitly quantified
196 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
197 Implicit `plus` Implicit = Implicit
198 _ `plus` _ = Explicit
200 hsExplicitTvs :: LHsType name -> [name]
201 -- The explicitly-given forall'd type variables of a HsType
202 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
205 ---------------------
206 type LHsTyVarBndr name = Located (HsTyVarBndr name)
208 data HsTyVarBndr name
210 | KindedTyVar name Kind
211 -- *** NOTA BENE *** A "monotype" in a pragma can have
212 -- for-alls in it, (mostly to do with dictionaries). These
213 -- must be explicitly Kinded.
215 hsTyVarName :: HsTyVarBndr name -> name
216 hsTyVarName (UserTyVar n) = n
217 hsTyVarName (KindedTyVar n _) = n
219 hsLTyVarName :: LHsTyVarBndr name -> name
220 hsLTyVarName = hsTyVarName . unLoc
222 hsTyVarNames :: [HsTyVarBndr name] -> [name]
223 hsTyVarNames tvs = map hsTyVarName tvs
225 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
226 hsLTyVarNames = map hsLTyVarName
228 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
229 hsLTyVarLocName = fmap hsTyVarName
231 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
232 hsLTyVarLocNames = map hsLTyVarLocName
234 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
235 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
236 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
242 :: OutputableBndr name
244 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
245 -- Split up an instance decl type, returning the pieces
247 splitHsInstDeclTy inst_ty
249 HsParTy (L _ ty) -> splitHsInstDeclTy ty
250 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
251 other -> split_tau [] [] other
252 -- The type vars should have been computed by now, even if they were implicit
254 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
255 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
256 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
258 -- Splits HsType into the (init, last) parts
259 -- Breaks up any parens in the result type:
260 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
261 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
262 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
264 (args, res) = splitHsFunType y
265 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
266 splitHsFunType other = ([], other)
270 %************************************************************************
272 \subsection{Pretty printing}
274 %************************************************************************
277 instance (OutputableBndr name) => Outputable (HsType name) where
278 ppr ty = pprHsType ty
280 instance (Outputable name) => Outputable (HsTyVarBndr name) where
281 ppr (UserTyVar name) = ppr name
282 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
284 instance OutputableBndr name => Outputable (HsPred name) where
285 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
286 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext SLIT("~"),
288 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
290 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
291 pprLHsType = pprParendHsType . unLoc
293 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
294 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
295 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
297 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
298 pprHsForAll exp tvs cxt
299 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
300 | otherwise = pprHsContext (unLoc cxt)
302 show_forall = opt_PprStyle_Debug
303 || (not (null tvs) && is_explicit)
304 is_explicit = case exp of {Explicit -> True; Implicit -> False}
305 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
307 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
308 pprHsContext [] = empty
309 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
311 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
312 ppr_hs_context [] = empty
313 ppr_hs_context cxt = parens (interpp'SP cxt)
317 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
318 pREC_TOP = 0 -- type in ParseIface.y
319 pREC_FUN = 1 -- btype in ParseIface.y
320 -- Used for LH arg of (->)
321 pREC_OP = 2 -- Used for arg of any infix operator
322 -- (we don't keep their fixities around)
323 pREC_CON = 3 -- Used for arg of type applicn:
324 -- always parenthesise unless atomic
326 maybeParen :: Int -- Precedence of context
327 -> Int -- Precedence of top-level operator
328 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
329 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
332 -- printing works more-or-less as for Types
334 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
336 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
337 pprParendHsType ty = ppr_mono_ty pREC_CON ty
339 -- Before printing a type
340 -- (a) Remove outermost HsParTy parens
341 -- (b) Drop top-level for-all type variables in user style
342 -- since they are implicit in Haskell
343 prepare :: PprStyle -> HsType name -> HsType name
344 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
347 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
348 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
350 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
351 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
352 = maybeParen ctxt_prec pREC_FUN $
353 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
355 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
356 ppr_mono_ty _ (HsTyVar name) = ppr name
357 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
358 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
359 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
360 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
361 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
362 ppr_mono_ty _ (HsPredTy pred) = ppr pred
363 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
364 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
366 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
367 = maybeParen ctxt_prec pREC_CON $
368 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
370 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
371 = maybeParen ctxt_prec pREC_OP $
372 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
374 ppr_mono_ty _ (HsParTy ty)
375 = parens (ppr_mono_lty pREC_TOP ty)
376 -- Put the parens in where the user did
377 -- But we still use the precedence stuff to add parens because
378 -- toHsType doesn't put in any HsParTys, so we may still need them
380 ppr_mono_ty _ (HsDocTy ty doc)
381 = ppr ty <+> ppr (unLoc doc)
383 --------------------------
384 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
385 ppr_fun_ty ctxt_prec ty1 ty2
386 = let p1 = ppr_mono_lty pREC_FUN ty1
387 p2 = ppr_mono_lty pREC_TOP ty2
389 maybeParen ctxt_prec pREC_FUN $
390 sep [p1, ptext SLIT("->") <+> p2]
392 --------------------------
393 pabrackets :: SDoc -> SDoc
394 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")