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 )
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] -- class constraint
107 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
108 | HsIParam (IPName name) (LHsType name)
110 type LHsType name = Located (HsType name)
113 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
114 -- the user wrote it originally, so that the printer can
115 -- print it as the user wrote it
116 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
117 -- until the renamer fills in the variables
121 | HsTyVar name -- Type variable or type constructor
123 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
125 | HsAppTy (LHsType name)
128 | HsFunTy (LHsType name) -- function type
131 | HsListTy (LHsType name) -- Element type
133 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
136 [LHsType name] -- Element types (length gives arity)
138 | HsOpTy (LHsType name) (Located name) (LHsType name)
140 | HsParTy (LHsType name)
141 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
142 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
144 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
145 -- interface files smaller), so when printing a HsType we may need to
148 | HsNumTy Integer -- Generics only
150 | HsPredTy (HsPred name) -- Only used in the type of an instance
151 -- declaration, eg. Eq [a] -> Eq a
154 -- Note no need for location info on the
155 -- enclosed HsPred; the one on the type will do
157 | HsKindSig (LHsType name) -- (ty :: kind)
158 Kind -- A type with a kind signature
160 | HsSpliceTy (HsSplice name)
162 | HsDocTy (LHsType name) (LHsDoc name) -- A documented type
164 data HsExplicitForAll = Explicit | Implicit
166 -----------------------
167 -- Combine adjacent for-alls.
168 -- The following awkward situation can happen otherwise:
169 -- f :: forall a. ((Num a) => Int)
170 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
171 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
172 -- but the export list abstracts f wrt [a]. Disaster.
174 -- A valid type must have one for-all at the top of the type, or of the fn arg types
176 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
177 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
178 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
179 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
181 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
182 -- Smart constructor for HsForAllTy
183 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
184 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
186 -- mk_forall_ty makes a pure for-all type (no context)
187 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
188 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
189 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
190 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
191 -- Even if tvs is empty, we still make a HsForAll!
192 -- In the Implicit case, this signals the place to do implicit quantification
193 -- In the Explicit case, it prevents implicit quantification
194 -- (see the sigtype production in Parser.y.pp)
195 -- so that (forall. ty) isn't implicitly quantified
197 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
198 Implicit `plus` Implicit = Implicit
199 _ `plus` _ = Explicit
201 hsExplicitTvs :: LHsType name -> [name]
202 -- The explicitly-given forall'd type variables of a HsType
203 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
206 ---------------------
207 type LHsTyVarBndr name = Located (HsTyVarBndr name)
209 data HsTyVarBndr name
211 | KindedTyVar name Kind
212 -- *** NOTA BENE *** A "monotype" in a pragma can have
213 -- for-alls in it, (mostly to do with dictionaries). These
214 -- must be explicitly Kinded.
216 hsTyVarName :: HsTyVarBndr name -> name
217 hsTyVarName (UserTyVar n) = n
218 hsTyVarName (KindedTyVar n _) = n
220 hsLTyVarName :: LHsTyVarBndr name -> name
221 hsLTyVarName = hsTyVarName . unLoc
223 hsTyVarNames :: [HsTyVarBndr name] -> [name]
224 hsTyVarNames tvs = map hsTyVarName tvs
226 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
227 hsLTyVarNames = map hsLTyVarName
229 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
230 hsLTyVarLocName = fmap hsTyVarName
232 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
233 hsLTyVarLocNames = map hsLTyVarLocName
235 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
236 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
237 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
243 :: OutputableBndr name
245 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
246 -- Split up an instance decl type, returning the pieces
248 splitHsInstDeclTy inst_ty
250 HsParTy (L _ ty) -> splitHsInstDeclTy ty
251 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
252 other -> split_tau [] [] other
253 -- The type vars should have been computed by now, even if they were implicit
255 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
256 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
257 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
259 -- Splits HsType into the (init, last) parts
260 -- Breaks up any parens in the result type:
261 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
262 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
263 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
265 (args, res) = splitHsFunType y
266 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
267 splitHsFunType other = ([], other)
271 %************************************************************************
273 \subsection{Pretty printing}
275 %************************************************************************
278 instance (OutputableBndr name) => Outputable (HsType name) where
279 ppr ty = pprHsType ty
281 instance (Outputable name) => Outputable (HsTyVarBndr name) where
282 ppr (UserTyVar name) = ppr name
283 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
285 instance OutputableBndr name => Outputable (HsPred name) where
286 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprLHsType tys)
287 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext SLIT("~"),
289 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
291 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
292 pprLHsType = pprParendHsType . unLoc
294 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
295 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
296 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
298 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
299 pprHsForAll exp tvs cxt
300 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
301 | otherwise = pprHsContext (unLoc cxt)
303 show_forall = opt_PprStyle_Debug
304 || (not (null tvs) && is_explicit)
305 is_explicit = case exp of {Explicit -> True; Implicit -> False}
306 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
308 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
309 pprHsContext [] = empty
310 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
312 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
313 ppr_hs_context [] = empty
314 ppr_hs_context cxt = parens (interpp'SP cxt)
318 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
319 pREC_TOP = 0 -- type in ParseIface.y
320 pREC_FUN = 1 -- btype in ParseIface.y
321 -- Used for LH arg of (->)
322 pREC_OP = 2 -- Used for arg of any infix operator
323 -- (we don't keep their fixities around)
324 pREC_CON = 3 -- Used for arg of type applicn:
325 -- always parenthesise unless atomic
327 maybeParen :: Int -- Precedence of context
328 -> Int -- Precedence of top-level operator
329 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
330 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
333 -- printing works more-or-less as for Types
335 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
337 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
338 pprParendHsType ty = ppr_mono_ty pREC_CON ty
340 -- Before printing a type
341 -- (a) Remove outermost HsParTy parens
342 -- (b) Drop top-level for-all type variables in user style
343 -- since they are implicit in Haskell
344 prepare :: PprStyle -> HsType name -> HsType name
345 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
348 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
349 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
351 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
352 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
353 = maybeParen ctxt_prec pREC_FUN $
354 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
356 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
357 ppr_mono_ty _ (HsTyVar name) = ppr name
358 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
359 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
360 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
361 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
362 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
363 ppr_mono_ty _ (HsPredTy pred) = ppr pred
364 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
365 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
367 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
368 = maybeParen ctxt_prec pREC_CON $
369 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
371 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
372 = maybeParen ctxt_prec pREC_OP $
373 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
375 ppr_mono_ty _ (HsParTy ty)
376 = parens (ppr_mono_lty pREC_TOP ty)
377 -- Put the parens in where the user did
378 -- But we still use the precedence stuff to add parens because
379 -- toHsType doesn't put in any HsParTys, so we may still need them
381 ppr_mono_ty _ (HsDocTy ty doc)
382 = ppr ty <+> ppr (unLoc doc)
384 --------------------------
385 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
386 ppr_fun_ty ctxt_prec ty1 ty2
387 = let p1 = ppr_mono_lty pREC_FUN ty1
388 p2 = ppr_mono_lty pREC_TOP ty2
390 maybeParen ctxt_prec pREC_FUN $
391 sep [p1, ptext SLIT("->") <+> p2]
393 --------------------------
394 pabrackets :: SDoc -> SDoc
395 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")