6d8013ccf7f7378c7a34fc6f591f9fae5d5eacbd
[ghc-hetmet.git] / ghc / compiler / hsSyn / HsTypes.lhs
1 ]%
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[HsTypes]{Abstract syntax: user-defined types}
5
6 \begin{code}
7 module HsTypes (
8           HsType(..), HsTyVarBndr(..), 
9         , HsContext, HsPred(..)
10
11         , mkHsForAllTy, mkHsDictTy, mkHsIParamTy
12         , hsTyVarName, hsTyVarNames, replaceTyVarName
13         , splitHsInstDeclTy
14         
15         -- Type place holder
16         , PostTcType, placeHolderType,
17
18         -- Name place holder
19         , SyntaxName, placeHolderName,
20
21         -- Printing
22         , pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
23     ) where
24
25 #include "HsVersions.h"
26
27 import TcType           ( Type, Kind, liftedTypeKind, eqKind )
28 import TypeRep          ( Type )
29 import Name             ( Name, mkInternalName )
30 import OccName          ( mkVarOcc )
31 import PprType          ( {- instance Outputable Kind -}, pprParendKind, pprKind )
32 import BasicTypes       ( IPName, Boxity, tupleParens )
33 import PrelNames        ( unboundKey )
34 import SrcLoc           ( noSrcLoc )
35 import Outputable
36 \end{code}
37
38
39 %************************************************************************
40 %*                                                                      *
41 \subsection{Annotating the syntax}
42 %*                                                                      *
43 %************************************************************************
44
45 \begin{code}
46 type PostTcType = Type          -- Used for slots in the abstract syntax
47                                 -- where we want to keep slot for a type
48                                 -- to be added by the type checker...but
49                                 -- before typechecking it's just bogus
50
51 placeHolderType :: PostTcType   -- Used before typechecking
52 placeHolderType  = panic "Evaluated the place holder for a PostTcType"
53
54
55 type SyntaxName = Name          -- These names are filled in by the renamer
56                                 -- Before then they are a placeHolderName (so that
57                                 --      we can still print the HsSyn)
58                                 -- They correspond to "rebindable syntax";
59                                 -- See RnEnv.lookupSyntaxName
60
61 placeHolderName :: SyntaxName
62 placeHolderName = mkInternalName unboundKey 
63                         (mkVarOcc FSLIT("syntaxPlaceHolder")) 
64                         noSrcLoc
65 \end{code}
66
67
68 %************************************************************************
69 %*                                                                      *
70 \subsection{Data types}
71 %*                                                                      *
72 %************************************************************************
73
74 This is the syntax for types as seen in type signatures.
75
76 \begin{code}
77 type HsContext name = [HsPred name]
78
79 data HsPred name = HsClassP name [HsType name]
80                  | HsIParam (IPName name) (HsType name)
81
82 data HsType name
83   = HsForAllTy  (Maybe [HsTyVarBndr name])      -- Nothing for implicitly quantified signatures
84                 (HsContext name)
85                 (HsType name)
86
87   | HsTyVar             name            -- Type variable or type constructor
88
89   | HsAppTy             (HsType name)
90                         (HsType name)
91
92   | HsFunTy             (HsType name)   -- function type
93                         (HsType name)
94
95   | HsListTy            (HsType name)   -- Element type
96
97   | HsPArrTy            (HsType name)   -- Elem. type of parallel array: [:t:]
98
99   | HsTupleTy           Boxity
100                         [HsType name]   -- Element types (length gives arity)
101
102   | HsOpTy              (HsType name) name (HsType name)
103
104   | HsParTy             (HsType name)   
105         -- Parenthesis preserved for the precedence re-arrangement in RnTypes
106         -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
107         -- 
108         -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
109         -- interface files smaller), so when printing a HsType we may need to
110         -- add parens.  
111
112   | HsNumTy             Integer         -- Generics only
113
114   -- these next two are only used in interfaces
115   | HsPredTy            (HsPred name)
116
117   | HsKindSig           (HsType name)   -- (ty :: kind)
118                         Kind            -- A type with a kind signature
119
120
121 -----------------------
122 -- Combine adjacent for-alls. 
123 -- The following awkward situation can happen otherwise:
124 --      f :: forall a. ((Num a) => Int)
125 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
126 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
127 -- but the export list abstracts f wrt [a].  Disaster.
128 --
129 -- A valid type must have one for-all at the top of the type, or of the fn arg types
130
131 mkHsForAllTy mtvs []   ty = mk_forall_ty mtvs ty
132 mkHsForAllTy mtvs ctxt ty = HsForAllTy mtvs ctxt ty
133
134 -- mk_forall_ty makes a pure for-all type (no context)
135 mk_forall_ty (Just []) ty                         = ty  -- Explicit for-all with no tyvars
136 mk_forall_ty mtvs1     (HsParTy ty)               = mk_forall_ty mtvs1 ty
137 mk_forall_ty mtvs1     (HsForAllTy mtvs2 ctxt ty) = mkHsForAllTy (mtvs1 `plus` mtvs2) ctxt ty
138 mk_forall_ty mtvs1     ty                         = HsForAllTy mtvs1 [] ty
139
140 mtvs1       `plus` Nothing     = mtvs1
141 Nothing     `plus` mtvs2       = mtvs2 
142 (Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
143
144 mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
145 mkHsIParamTy v ty  = HsPredTy (HsIParam v ty)
146
147 data HsTyVarBndr name
148   = UserTyVar name
149   | KindedTyVar name Kind
150         -- *** NOTA BENE *** A "monotype" in a pragma can have
151         -- for-alls in it, (mostly to do with dictionaries).  These
152         -- must be explicitly Kinded.
153
154 hsTyVarName (UserTyVar n)     = n
155 hsTyVarName (KindedTyVar n _) = n
156
157 hsTyVarNames tvs = map hsTyVarName tvs
158
159 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
160 replaceTyVarName (UserTyVar n)     n' = UserTyVar n'
161 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
162 \end{code}
163
164
165 \begin{code}
166 splitHsInstDeclTy 
167     :: Outputable name
168     => HsType name 
169     -> ([HsTyVarBndr name], HsContext name, name, [HsType name])
170         -- Split up an instance decl type, returning the pieces
171
172 -- In interface files, the instance declaration head is created
173 -- by HsTypes.toHsType, which does not guarantee to produce a
174 -- HsForAllTy.  For example, if we had the weird decl
175 --      instance Foo T => Foo [T]
176 -- then we'd get the instance type
177 --      Foo T -> Foo [T]
178 -- So when colleting the instance context, to be on the safe side
179 -- we gather predicate arguments
180 -- 
181 -- For source code, the parser ensures the type will have the right shape.
182 -- (e.g. see ParseUtil.checkInstType)
183
184 splitHsInstDeclTy inst_ty
185   = case inst_ty of
186         HsForAllTy (Just tvs) cxt1 tau 
187               -> (tvs, cxt1++cxt2, cls, tys)
188               where
189                  (cxt2, cls, tys) = split_tau tau
190
191         other -> ([],  cxt2,  cls, tys)
192               where
193                  (cxt2, cls, tys) = split_tau inst_ty
194
195   where
196     split_tau (HsFunTy (HsPredTy p) ty) = (p:ps, cls, tys)
197                                         where
198                                           (ps, cls, tys) = split_tau ty
199     split_tau (HsPredTy (HsClassP cls tys)) = ([], cls,tys)
200     split_tau other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
201 \end{code}
202
203
204 %************************************************************************
205 %*                                                                      *
206 \subsection{Pretty printing}
207 %*                                                                      *
208 %************************************************************************
209
210 NB: these types get printed into interface files, so 
211     don't change the printing format lightly
212
213 \begin{code}
214 instance (Outputable name) => Outputable (HsType name) where
215     ppr ty = pprHsType ty
216
217 instance (Outputable name) => Outputable (HsTyVarBndr name) where
218     ppr (UserTyVar name)        = ppr name
219     ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
220
221 instance Outputable name => Outputable (HsPred name) where
222     ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprParendHsType tys)
223     ppr (HsIParam n ty)    = hsep [ppr n, dcolon, ppr ty]
224
225 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
226 pprHsTyVarBndr name kind | kind `eqKind` liftedTypeKind = ppr name
227                          | otherwise                    = hsep [ppr name, dcolon, pprParendKind kind]
228
229 pprHsForAll []  []  = empty
230 pprHsForAll tvs cxt = ptext SLIT("forall") <+> interppSP tvs <+> pprHsContext cxt
231
232 pprHsContext :: (Outputable name) => HsContext name -> SDoc
233 pprHsContext []  = empty
234 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
235
236 ppr_hs_context []  = empty
237 ppr_hs_context cxt = parens (interpp'SP cxt)
238 \end{code}
239
240 \begin{code}
241 pREC_TOP = (0 :: Int)  -- type   in ParseIface.y
242 pREC_FUN = (1 :: Int)  -- btype  in ParseIface.y
243                         -- Used for LH arg of (->)
244 pREC_OP  = (2 :: Int)   -- Used for arg of any infix operator
245                         -- (we don't keep their fixities around)
246 pREC_CON = (3 :: Int)   -- Used for arg of type applicn: 
247                         -- always parenthesise unless atomic
248
249 maybeParen :: Int       -- Precedence of context
250            -> Int       -- Precedence of top-level operator
251            -> SDoc -> SDoc      -- Wrap in parens if (ctxt >= op)
252 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
253                                | otherwise            = p
254         
255 -- printing works more-or-less as for Types
256
257 pprHsType, pprParendHsType :: (Outputable name) => HsType name -> SDoc
258
259 pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
260 pprParendHsType ty = ppr_mono_ty pREC_CON ty
261
262 -- Before printing a type
263 -- (a) Remove outermost HsParTy parens
264 -- (b) Drop top-level for-all type variables in user style
265 --     since they are implicit in Haskell
266 prepare sty (HsParTy ty)          = prepare sty ty
267 prepare sty (HsForAllTy _ cxt ty) | userStyle sty = (HsForAllTy Nothing cxt ty)
268 prepare sty ty                    = ty
269
270 ppr_mono_ty ctxt_prec (HsForAllTy maybe_tvs ctxt ty)
271   = maybeParen ctxt_prec pREC_FUN $
272     sep [pp_header, ppr_mono_ty pREC_TOP ty]
273   where
274     pp_header = case maybe_tvs of
275                   Just tvs -> pprHsForAll tvs ctxt
276                   Nothing  -> pprHsContext ctxt
277
278 ppr_mono_ty ctxt_prec (HsTyVar name)      = ppr name
279 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
280 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
281 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
282 ppr_mono_ty ctxt_prec (HsListTy ty)       = brackets (ppr_mono_ty pREC_TOP ty)
283 ppr_mono_ty ctxt_prec (HsPArrTy ty)       = pabrackets (ppr_mono_ty pREC_TOP ty)
284 ppr_mono_ty ctxt_prec (HsPredTy pred)     = braces (ppr pred)
285 ppr_mono_ty ctxt_prec (HsNumTy n)         = integer n  -- generics only
286
287 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
288   = maybeParen ctxt_prec pREC_CON $
289     hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty]
290
291 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)  
292   = maybeParen ctxt_prec pREC_OP $
293     ppr_mono_ty pREC_OP ty1 <+> ppr op <+> ppr_mono_ty pREC_OP ty2
294
295 ppr_mono_ty ctxt_prec (HsParTy ty)
296   = parens (ppr_mono_ty pREC_TOP ty)
297   -- Put the parens in where the user did
298   -- But we still use the precedence stuff to add parens because
299   --    toHsType doesn't put in any HsParTys, so we may still need them
300
301 --------------------------
302 ppr_fun_ty ctxt_prec ty1 ty2
303   = let p1 = ppr_mono_ty pREC_FUN ty1
304         p2 = ppr_mono_ty pREC_TOP ty2
305     in
306     maybeParen ctxt_prec pREC_FUN $
307     sep [p1, ptext SLIT("->") <+> p2]
308
309 --------------------------
310 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
311 \end{code}
312
313