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 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
43 %************************************************************************
45 \subsection{Annotating the syntax}
47 %************************************************************************
50 type PostTcType = Type -- Used for slots in the abstract syntax
51 -- where we want to keep slot for a type
52 -- to be added by the type checker...but
53 -- before typechecking it's just bogus
55 placeHolderType :: PostTcType -- Used before typechecking
56 placeHolderType = panic "Evaluated the place holder for a PostTcType"
59 %************************************************************************
61 \subsection{Bang annotations}
63 %************************************************************************
66 type LBangType name = Located (BangType name)
67 type BangType name = HsType name -- Bangs are in the HsType data type
69 data HsBang = HsNoBang -- Only used as a return value for getBangStrictness,
70 -- never appears on a HsBangTy
72 | HsUnbox -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
74 instance Outputable HsBang where
75 ppr (HsNoBang) = empty
76 ppr (HsStrict) = char '!'
77 ppr (HsUnbox) = ptext (sLit "!!")
79 getBangType :: LHsType a -> LHsType a
80 getBangType (L _ (HsBangTy _ ty)) = ty
83 getBangStrictness :: LHsType a -> HsBang
84 getBangStrictness (L _ (HsBangTy s _)) = s
85 getBangStrictness _ = HsNoBang
89 %************************************************************************
91 \subsection{Data types}
93 %************************************************************************
95 This is the syntax for types as seen in type signatures.
98 type LHsContext name = Located (HsContext name)
100 type HsContext name = [LHsPred name]
102 type LHsPred name = Located (HsPred name)
104 data HsPred name = HsClassP name [LHsType name] -- class constraint
105 | HsEqualP (LHsType name) (LHsType name)-- equality constraint
106 | HsIParam (IPName name) (LHsType name)
108 type LHsType name = Located (HsType name)
111 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
112 -- the user wrote it originally, so that the printer can
113 -- print it as the user wrote it
114 [LHsTyVarBndr name] -- With ImplicitForAll, this is the empty list
115 -- until the renamer fills in the variables
119 | HsTyVar name -- Type variable or type constructor
121 | HsBangTy HsBang (LHsType name) -- Bang-style type annotations
123 | HsAppTy (LHsType name)
126 | HsFunTy (LHsType name) -- function type
129 | HsListTy (LHsType name) -- Element type
131 | HsPArrTy (LHsType name) -- Elem. type of parallel array: [:t:]
134 [LHsType name] -- Element types (length gives arity)
136 | HsOpTy (LHsType name) (Located name) (LHsType name)
138 | HsParTy (LHsType name)
139 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
140 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
142 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
143 -- interface files smaller), so when printing a HsType we may need to
146 | HsNumTy Integer -- Generics only
148 | HsPredTy (HsPred name) -- Only used in the type of an instance
149 -- declaration, eg. Eq [a] -> Eq a
152 -- Note no need for location info on the
153 -- enclosed HsPred; the one on the type will do
155 | HsKindSig (LHsType name) -- (ty :: kind)
156 Kind -- A type with a kind signature
158 | HsSpliceTy (HsSplice name)
160 | HsDocTy (LHsType name) (LHsDoc name) -- A documented type
162 data HsExplicitForAll = Explicit | Implicit
164 -----------------------
165 -- Combine adjacent for-alls.
166 -- The following awkward situation can happen otherwise:
167 -- f :: forall a. ((Num a) => Int)
168 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
169 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
170 -- but the export list abstracts f wrt [a]. Disaster.
172 -- A valid type must have one for-all at the top of the type, or of the fn arg types
174 mkImplicitHsForAllTy :: LHsContext name -> LHsType name -> HsType name
175 mkExplicitHsForAllTy :: [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
176 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
177 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
179 mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
180 -- Smart constructor for HsForAllTy
181 mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
182 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
184 -- mk_forall_ty makes a pure for-all type (no context)
185 mk_forall_ty :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsType name -> HsType name
186 mk_forall_ty exp tvs (L _ (HsParTy ty)) = mk_forall_ty exp tvs ty
187 mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
188 mk_forall_ty exp tvs ty = HsForAllTy exp tvs (L noSrcSpan []) ty
189 -- Even if tvs is empty, we still make a HsForAll!
190 -- In the Implicit case, this signals the place to do implicit quantification
191 -- In the Explicit case, it prevents implicit quantification
192 -- (see the sigtype production in Parser.y.pp)
193 -- so that (forall. ty) isn't implicitly quantified
195 plus :: HsExplicitForAll -> HsExplicitForAll -> HsExplicitForAll
196 Implicit `plus` Implicit = Implicit
197 _ `plus` _ = Explicit
199 hsExplicitTvs :: LHsType name -> [name]
200 -- The explicitly-given forall'd type variables of a HsType
201 hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
204 ---------------------
205 type LHsTyVarBndr name = Located (HsTyVarBndr name)
207 data HsTyVarBndr name
209 | KindedTyVar name Kind
210 -- *** NOTA BENE *** A "monotype" in a pragma can have
211 -- for-alls in it, (mostly to do with dictionaries). These
212 -- must be explicitly Kinded.
214 hsTyVarName :: HsTyVarBndr name -> name
215 hsTyVarName (UserTyVar n) = n
216 hsTyVarName (KindedTyVar n _) = n
218 hsLTyVarName :: LHsTyVarBndr name -> name
219 hsLTyVarName = hsTyVarName . unLoc
221 hsTyVarNames :: [HsTyVarBndr name] -> [name]
222 hsTyVarNames tvs = map hsTyVarName tvs
224 hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
225 hsLTyVarNames = map hsLTyVarName
227 hsLTyVarLocName :: LHsTyVarBndr name -> Located name
228 hsLTyVarLocName = fmap hsTyVarName
230 hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
231 hsLTyVarLocNames = map hsLTyVarLocName
233 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
234 replaceTyVarName (UserTyVar _) n' = UserTyVar n'
235 replaceTyVarName (KindedTyVar _ k) n' = KindedTyVar n' k
241 :: OutputableBndr name
243 -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
244 -- Split up an instance decl type, returning the pieces
246 splitHsInstDeclTy inst_ty
248 HsParTy (L _ ty) -> splitHsInstDeclTy ty
249 HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
250 other -> split_tau [] [] other
251 -- The type vars should have been computed by now, even if they were implicit
253 split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
254 split_tau tvs cxt (HsParTy (L _ ty)) = split_tau tvs cxt ty
255 split_tau _ _ _ = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
257 -- Splits HsType into the (init, last) parts
258 -- Breaks up any parens in the result type:
259 -- splitHsFunType (a -> (b -> c)) = ([a,b], c)
260 splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
261 splitHsFunType (L _ (HsFunTy x y)) = (x:args, res)
263 (args, res) = splitHsFunType y
264 splitHsFunType (L _ (HsParTy ty)) = splitHsFunType ty
265 splitHsFunType other = ([], other)
269 %************************************************************************
271 \subsection{Pretty printing}
273 %************************************************************************
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 pprLHsType tys)
285 ppr (HsEqualP t1 t2) = hsep [pprLHsType t1, ptext (sLit "~"),
287 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
289 pprLHsType :: OutputableBndr name => LHsType name -> SDoc
290 pprLHsType = pprParendHsType . unLoc
292 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
293 pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
294 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
296 pprHsForAll :: OutputableBndr name => HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> SDoc
297 pprHsForAll exp tvs cxt
298 | show_forall = forall_part <+> pprHsContext (unLoc cxt)
299 | otherwise = pprHsContext (unLoc cxt)
301 show_forall = opt_PprStyle_Debug
302 || (not (null tvs) && is_explicit)
303 is_explicit = case exp of {Explicit -> True; Implicit -> False}
304 forall_part = ptext (sLit "forall") <+> interppSP tvs <> dot
306 pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
307 pprHsContext [] = empty
308 pprHsContext cxt = ppr_hs_context cxt <+> ptext (sLit "=>")
310 ppr_hs_context :: (OutputableBndr name) => HsContext name -> SDoc
311 ppr_hs_context [] = empty
312 ppr_hs_context cxt = parens (interpp'SP cxt)
316 pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
317 pREC_TOP = 0 -- type in ParseIface.y
318 pREC_FUN = 1 -- btype in ParseIface.y
319 -- Used for LH arg of (->)
320 pREC_OP = 2 -- Used for arg of any infix operator
321 -- (we don't keep their fixities around)
322 pREC_CON = 3 -- Used for arg of type applicn:
323 -- always parenthesise unless atomic
325 maybeParen :: Int -- Precedence of context
326 -> Int -- Precedence of top-level operator
327 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
328 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
331 -- printing works more-or-less as for Types
333 pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
335 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
336 pprParendHsType ty = ppr_mono_ty pREC_CON ty
338 -- Before printing a type
339 -- (a) Remove outermost HsParTy parens
340 -- (b) Drop top-level for-all type variables in user style
341 -- since they are implicit in Haskell
342 prepare :: PprStyle -> HsType name -> HsType name
343 prepare sty (HsParTy ty) = prepare sty (unLoc ty)
346 ppr_mono_lty :: (OutputableBndr name) => Int -> LHsType name -> SDoc
347 ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
349 ppr_mono_ty :: (OutputableBndr name) => Int -> HsType name -> SDoc
350 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
351 = maybeParen ctxt_prec pREC_FUN $
352 sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
354 ppr_mono_ty _ (HsBangTy b ty) = ppr b <> ppr ty
355 ppr_mono_ty _ (HsTyVar name) = ppr name
356 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
357 ppr_mono_ty _ (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
358 ppr_mono_ty _ (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
359 ppr_mono_ty _ (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
360 ppr_mono_ty _ (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
361 ppr_mono_ty _ (HsPredTy pred) = ppr pred
362 ppr_mono_ty _ (HsNumTy n) = integer n -- generics only
363 ppr_mono_ty _ (HsSpliceTy s) = pprSplice s
365 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
366 = maybeParen ctxt_prec pREC_CON $
367 hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
369 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
370 = maybeParen ctxt_prec pREC_OP $
371 ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
373 ppr_mono_ty _ (HsParTy ty)
374 = parens (ppr_mono_lty pREC_TOP ty)
375 -- Put the parens in where the user did
376 -- But we still use the precedence stuff to add parens because
377 -- toHsType doesn't put in any HsParTys, so we may still need them
379 ppr_mono_ty ctxt_prec (HsDocTy ty doc)
380 = maybeParen ctxt_prec pREC_OP $
381 ppr_mono_lty pREC_OP ty <+> ppr (unLoc doc)
382 -- we pretty print Haddock comments on types as if they were
385 --------------------------
386 ppr_fun_ty :: (OutputableBndr name) => Int -> LHsType name -> LHsType name -> SDoc
387 ppr_fun_ty ctxt_prec ty1 ty2
388 = let p1 = ppr_mono_lty pREC_FUN ty1
389 p2 = ppr_mono_lty pREC_TOP ty2
391 maybeParen ctxt_prec pREC_FUN $
392 sep [p1, ptext (sLit "->") <+> p2]
394 --------------------------
395 pabrackets :: SDoc -> SDoc
396 pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")