2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsTypes]{Abstract syntax: user-defined types}
8 HsType(..), HsTyVarBndr(..), HsExplicitForAll(..),
9 , HsContext, HsPred(..)
11 , mkExplicitHsForAllTy, mkImplicitHsForAllTy,
12 , mkHsDictTy, mkHsIParamTy
13 , hsTyVarName, hsTyVarNames, replaceTyVarName
17 , PostTcType, placeHolderType,
20 , SyntaxName, placeHolderName,
23 , pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
26 #include "HsVersions.h"
28 import TcType ( Type, Kind, liftedTypeKind, eqKind )
29 import Type ( {- instance Outputable Kind -}, pprParendKind, pprKind )
30 import Name ( Name, mkInternalName )
31 import OccName ( mkVarOcc )
32 import BasicTypes ( IPName, Boxity, tupleParens )
33 import PrelNames ( unboundKey )
34 import SrcLoc ( noSrcLoc )
35 import CmdLineOpts ( opt_PprStyle_Debug )
40 %************************************************************************
42 \subsection{Annotating the syntax}
44 %************************************************************************
47 type PostTcType = Type -- Used for slots in the abstract syntax
48 -- where we want to keep slot for a type
49 -- to be added by the type checker...but
50 -- before typechecking it's just bogus
52 placeHolderType :: PostTcType -- Used before typechecking
53 placeHolderType = panic "Evaluated the place holder for a PostTcType"
56 type SyntaxName = Name -- These names are filled in by the renamer
57 -- Before then they are a placeHolderName (so that
58 -- we can still print the HsSyn)
59 -- They correspond to "rebindable syntax";
60 -- See RnEnv.lookupSyntaxName
62 placeHolderName :: SyntaxName
63 placeHolderName = mkInternalName unboundKey
64 (mkVarOcc FSLIT("syntaxPlaceHolder"))
69 %************************************************************************
71 \subsection{Data types}
73 %************************************************************************
75 This is the syntax for types as seen in type signatures.
78 type HsContext name = [HsPred name]
80 data HsPred name = HsClassP name [HsType name]
81 | HsIParam (IPName name) (HsType name)
84 = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
85 -- the user wrote it originally, so that the printer can
86 -- print it as the user wrote it
87 [HsTyVarBndr name] -- With ImplicitForAll, this is the empty list
88 -- until the renamer fills in the variables
92 | HsTyVar name -- Type variable or type constructor
94 | HsAppTy (HsType name)
97 | HsFunTy (HsType name) -- function type
100 | HsListTy (HsType name) -- Element type
102 | HsPArrTy (HsType name) -- Elem. type of parallel array: [:t:]
105 [HsType name] -- Element types (length gives arity)
107 | HsOpTy (HsType name) name (HsType name)
109 | HsParTy (HsType name)
110 -- Parenthesis preserved for the precedence re-arrangement in RnTypes
111 -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
113 -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
114 -- interface files smaller), so when printing a HsType we may need to
117 | HsNumTy Integer -- Generics only
119 -- these next two are only used in interfaces
120 | HsPredTy (HsPred name)
122 | HsKindSig (HsType name) -- (ty :: kind)
123 Kind -- A type with a kind signature
125 data HsExplicitForAll = Explicit | Implicit
127 -----------------------
128 -- Combine adjacent for-alls.
129 -- The following awkward situation can happen otherwise:
130 -- f :: forall a. ((Num a) => Int)
131 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
132 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
133 -- but the export list abstracts f wrt [a]. Disaster.
135 -- A valid type must have one for-all at the top of the type, or of the fn arg types
137 mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
138 mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
140 mkHsForAllTy :: HsExplicitForAll -> [HsTyVarBndr name] -> HsContext name -> HsType name -> HsType name
141 -- Smart constructor for HsForAllTy
142 mkHsForAllTy exp tvs [] ty = mk_forall_ty exp tvs ty
143 mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
145 -- mk_forall_ty makes a pure for-all type (no context)
146 mk_forall_ty Explicit [] ty = ty -- Explicit for-all with no tyvars
147 mk_forall_ty exp tvs (HsParTy ty) = mk_forall_ty exp tvs ty
148 mk_forall_ty exp1 tvs1 (HsForAllTy exp2 tvs2 ctxt ty) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
149 mk_forall_ty exp tvs ty = HsForAllTy exp tvs [] ty
151 Implicit `plus` Implicit = Implicit
152 exp1 `plus` exp2 = Explicit
154 mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
155 mkHsIParamTy v ty = HsPredTy (HsIParam v ty)
157 data HsTyVarBndr name
159 | KindedTyVar name Kind
160 -- *** NOTA BENE *** A "monotype" in a pragma can have
161 -- for-alls in it, (mostly to do with dictionaries). These
162 -- must be explicitly Kinded.
164 hsTyVarName (UserTyVar n) = n
165 hsTyVarName (KindedTyVar n _) = n
167 hsTyVarNames tvs = map hsTyVarName tvs
169 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
170 replaceTyVarName (UserTyVar n) n' = UserTyVar n'
171 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
179 -> ([HsTyVarBndr name], HsContext name, name, [HsType name])
180 -- Split up an instance decl type, returning the pieces
182 -- In interface files, the instance declaration head is created
183 -- by HsTypes.toHsType, which does not guarantee to produce a
184 -- HsForAllTy. For example, if we had the weird decl
185 -- instance Foo T => Foo [T]
186 -- then we'd get the instance type
188 -- So when colleting the instance context, to be on the safe side
189 -- we gather predicate arguments
191 -- For source code, the parser ensures the type will have the right shape.
192 -- (e.g. see ParseUtil.checkInstType)
194 splitHsInstDeclTy inst_ty
196 HsForAllTy _ tvs cxt1 tau -- The type vars should have been
197 -- computed by now, even if they were implicit
198 -> (tvs, cxt1++cxt2, cls, tys)
200 (cxt2, cls, tys) = split_tau tau
202 other -> ([], cxt2, cls, tys)
204 (cxt2, cls, tys) = split_tau inst_ty
207 split_tau (HsFunTy (HsPredTy p) ty) = (p:ps, cls, tys)
209 (ps, cls, tys) = split_tau ty
210 split_tau (HsPredTy (HsClassP cls tys)) = ([], cls,tys)
211 split_tau other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
215 %************************************************************************
217 \subsection{Pretty printing}
219 %************************************************************************
221 NB: these types get printed into interface files, so
222 don't change the printing format lightly
225 instance (Outputable name) => Outputable (HsType name) where
226 ppr ty = pprHsType ty
228 instance (Outputable name) => Outputable (HsTyVarBndr name) where
229 ppr (UserTyVar name) = ppr name
230 ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
232 instance Outputable name => Outputable (HsPred name) where
233 ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprParendHsType tys)
234 ppr (HsIParam n ty) = hsep [ppr n, dcolon, ppr ty]
236 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
237 pprHsTyVarBndr name kind | kind `eqKind` liftedTypeKind = ppr name
238 | otherwise = hsep [ppr name, dcolon, pprParendKind kind]
240 pprHsForAll exp tvs cxt
241 | show_forall = forall_part <+> pprHsContext cxt
242 | otherwise = pprHsContext cxt
244 show_forall = opt_PprStyle_Debug
245 || (not (null tvs) && is_explicit)
246 is_explicit = case exp of {Explicit -> True; Implicit -> False}
247 forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
249 pprHsContext :: (Outputable name) => HsContext name -> SDoc
250 pprHsContext [] = empty
251 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
253 ppr_hs_context [] = empty
254 ppr_hs_context cxt = parens (interpp'SP cxt)
258 pREC_TOP = (0 :: Int) -- type in ParseIface.y
259 pREC_FUN = (1 :: Int) -- btype in ParseIface.y
260 -- Used for LH arg of (->)
261 pREC_OP = (2 :: Int) -- Used for arg of any infix operator
262 -- (we don't keep their fixities around)
263 pREC_CON = (3 :: Int) -- Used for arg of type applicn:
264 -- always parenthesise unless atomic
266 maybeParen :: Int -- Precedence of context
267 -> Int -- Precedence of top-level operator
268 -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
269 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
272 -- printing works more-or-less as for Types
274 pprHsType, pprParendHsType :: (Outputable name) => HsType name -> SDoc
276 pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
277 pprParendHsType ty = ppr_mono_ty pREC_CON ty
279 -- Before printing a type
280 -- (a) Remove outermost HsParTy parens
281 -- (b) Drop top-level for-all type variables in user style
282 -- since they are implicit in Haskell
283 prepare sty (HsParTy ty) = prepare sty ty
286 ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
287 = maybeParen ctxt_prec pREC_FUN $
288 sep [pprHsForAll exp tvs ctxt, ppr_mono_ty pREC_TOP ty]
290 ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
291 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
292 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
293 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
294 ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_ty pREC_TOP ty)
295 ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_ty pREC_TOP ty)
296 ppr_mono_ty ctxt_prec (HsPredTy pred) = braces (ppr pred)
297 ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
299 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
300 = maybeParen ctxt_prec pREC_CON $
301 hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty]
303 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
304 = maybeParen ctxt_prec pREC_OP $
305 ppr_mono_ty pREC_OP ty1 <+> ppr op <+> ppr_mono_ty pREC_OP ty2
307 ppr_mono_ty ctxt_prec (HsParTy ty)
308 = parens (ppr_mono_ty pREC_TOP ty)
309 -- Put the parens in where the user did
310 -- But we still use the precedence stuff to add parens because
311 -- toHsType doesn't put in any HsParTys, so we may still need them
313 --------------------------
314 ppr_fun_ty ctxt_prec ty1 ty2
315 = let p1 = ppr_mono_ty pREC_FUN ty1
316 p2 = ppr_mono_ty pREC_TOP ty2
318 maybeParen ctxt_prec pREC_FUN $
319 sep [p1, ptext SLIT("->") <+> p2]
321 --------------------------
322 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")