TypeRep.lhs 13.2 KB
Newer Older
1
2
3
4
5
6
7
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[TypeRep]{Type - friends' interface}

\begin{code}
module TypeRep (
8
	TyThing(..), 
9
	Type(..), TyNote(..), 		-- Representation visible 
10
	PredType(..),	 		-- to friends
11
	
12
 	Kind, ThetaType,		-- Synonyms
13

14
15
	funTyCon,

16
	-- Pretty-printing
17
	pprType, pprParendType, pprTyThingCategory,
18
19
20
21
22
23
24
	pprPred, pprTheta, pprThetaArrow, pprClassPred,

	-- Re-export fromKind
	liftedTypeKind, unliftedTypeKind, openTypeKind,
	isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, 
	mkArrowKind, mkArrowKinds,
	pprKind, pprParendKind
25
26
27
28
    ) where

#include "HsVersions.h"

29
import {-# SOURCE #-} DataCon( DataCon, dataConName )
30

31
-- friends:
32
import Kind
33
import Var	  ( Var, Id, TyVar, tyVarKind )
34
import VarSet     ( TyVarSet )
35
import Name	  ( Name, NamedThing(..), BuiltInSyntax(..), mkWiredInName )
36
import OccName	  ( mkOccFS, tcName, parenSymOcc )
37
import BasicTypes ( IPName, tupleParens )
38
import TyCon	  ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon, isNewTyCon )
39
import Class	  ( Class )
40
41

-- others
42
import PrelNames  ( gHC_PRIM, funTyConKey, listTyConKey, parrTyConKey, hasKey )
43
import Outputable
44
45
46
47
48
49
50
51
52
53
54
\end{code}

%************************************************************************
%*									*
\subsection{Type Classifications}
%*									*
%************************************************************************

A type is

	*unboxed*	iff its representation is other than a pointer
55
			Unboxed types are also unlifted.
56
57
58
59
60
61

	*lifted*	A type is lifted iff it has bottom as an element.
			Closures always have lifted types:  i.e. any
			let-bound identifier in Core must have a lifted
			type.  Operationally, a lifted object is one that
			can be entered.
62
63

			Only lifted types may be unified with a type variable.
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

	*algebraic*	A type with one or more constructors, whether declared
			with "data" or "newtype".   
			An algebraic type is one that can be deconstructed
			with a case expression.  
			*NOT* the same as lifted types,  because we also 
			include unboxed tuples in this classification.

	*data*		A type declared with "data".  Also boxed tuples.

	*primitive*	iff it is a built-in type that can't be expressed
			in Haskell.

Currently, all primitive types are unlifted, but that's not necessarily
the case.  (E.g. Int could be primitive.)

Some primitive types are unboxed, such as Int#, whereas some are boxed
but unlifted (such as ByteArray#).  The only primitive types that we
classify as algebraic are the unboxed tuples.

examples of type classifications:

Type		primitive	boxed		lifted		algebraic    
-----------------------------------------------------------------------------
Int#,		Yes		No		No		No
ByteArray#	Yes		Yes		No		No
(# a, b #)	Yes		No		No		Yes
(  a, b  )	No		Yes		Yes		Yes
[a]		No		Yes		Yes		Yes

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114


	----------------------
	A note about newtypes
	----------------------

Consider
	newtype N = MkN Int

Then we want N to be represented as an Int, and that's what we arrange.
The front end of the compiler [TcType.lhs] treats N as opaque, 
the back end treats it as transparent [Type.lhs].

There's a bit of a problem with recursive newtypes
	newtype P = MkP P
	newtype Q = MkQ (Q->Q)

Here the 'implicit expansion' we get from treating P and Q as transparent
would give rise to infinite types, which in turn makes eqType diverge.
Similarly splitForAllTys and splitFunTys can get into a loop.  

115
116
Solution: 

117
* Newtypes are always represented using TyConApp.
118

119
120
121
122
123
* For non-recursive newtypes, P, treat P just like a type synonym after 
  type-checking is done; i.e. it's opaque during type checking (functions
  from TcType) but transparent afterwards (functions from Type).  
  "Treat P as a type synonym" means "all functions expand NewTcApps 
  on the fly".
124

125
126
127
  Applications of the data constructor P simply vanish:
	P x = x
  
128

129
130
131
132
133
* For recursive newtypes Q, treat the Q and its representation as 
  distinct right through the compiler.  Applications of the data consructor
  use a coerce:
	Q = \(x::Q->Q). coerce Q x
  They are rare, so who cares if they are a tiny bit less efficient.
134

135
136
The typechecker (TcTyDecls) identifies enough type construtors as 'recursive'
to cut all loops.  The other members of the loop may be marked 'non-recursive'.
137
138


139
140
141
142
143
144
145
146
147
%************************************************************************
%*									*
\subsection{The data type}
%*									*
%************************************************************************


\begin{code}
data Type
148
  = TyVarTy TyVar	
149
150

  | AppTy
151
	Type		-- Function is *not* a TyConApp
152
153
	Type		-- It must be another AppTy, or TyVarTy
			-- (or NoteTy of these)
154

155
  | TyConApp		-- Application of a TyCon, including newtypes
156
	TyCon		--  *Invariant* saturated appliations of FunTyCon and
157
			-- 	synonyms have their own constructors, below.
158
159
160
			-- However, *unsaturated* type synonyms, and FunTyCons
			-- 	do appear as TyConApps.  (Unsaturated type synonyms
			--	can appear as the RHS of a type synonym, for exmaple.)
161
162
	[Type]		-- Might not be saturated.

163
  | FunTy		-- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
164
165
166
	Type
	Type

167
168
169
170
  | ForAllTy		-- A polymorphic type
	TyVar
	Type	

171
172
  | PredTy		-- A high level source type 
	PredType	-- ...can be expanded to a representation type...
173
174

  | NoteTy 		-- A type with a note attached
175
176
177
178
	TyNote
	Type		-- The expanded version

data TyNote
179
  = FTVNote TyVarSet	-- The free type variables of the noted expression
180

181
182
183
  | SynNote Type	-- Used for type synonyms
			-- The Type is always a TyConApp, and is the un-expanded form.
			-- The type to which the note is attached is the expanded form.
184
185
186
\end{code}

-------------------------------------
187
188
189
 		Source types

A type of the form
190
191
192
	PredTy p
represents a value whose type is the Haskell predicate p, 
where a predicate is what occurs before the '=>' in a Haskell type.
193
194
195
196
197
It can be expanded into its representation, but: 

	* The type checker must treat it as opaque
	* The rest of the compiler treats it as transparent

198
199
200
201
202
203
204
205
206
Consider these examples:
	f :: (Eq a) => a -> Int
	g :: (?x :: Int -> Int) => a -> Int
	h :: (r\l) => {r} => {l::Int | r}

Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates*
Predicates are represented inside GHC by PredType:

\begin{code}
207
data PredType 
208
209
210
  = ClassP Class [Type]		-- Class predicate
  | IParam (IPName Name) Type	-- Implicit parameter

211
type ThetaType = [PredType]
212
213
\end{code}

214
215
216
217
218
219
220
221
222
223
224
225
(We don't support TREX records yet, but the setup is designed
to expand to allow them.)

A Haskell qualified type, such as that for f,g,h above, is
represented using 
	* a FunTy for the double arrow
	* with a PredTy as the function argument

The predicate really does turn into a real extra argument to the
function.  If the argument has type (PredTy p) then the predicate p is
represented by evidence (a dictionary, for example, of type (predRepTy p).

226

227
228
229
230
231
232
233
234
235
%************************************************************************
%*									*
			TyThing
%*									*
%************************************************************************

Despite the fact that DataCon has to be imported via a hi-boot route, 
this module seems the right place for TyThing, because it's needed for
funTyCon and all the types in TysPrim.
236
237

\begin{code}
238
239
240
241
data TyThing = AnId     Id
	     | ADataCon DataCon
	     | ATyCon   TyCon
	     | AClass   Class
242
243

instance Outputable TyThing where
244
245
246
247
248
249
250
  ppr thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))

pprTyThingCategory :: TyThing -> SDoc
pprTyThingCategory (ATyCon _) 	= ptext SLIT("Type constructor")
pprTyThingCategory (AClass _)   = ptext SLIT("Class")
pprTyThingCategory (AnId   _)   = ptext SLIT("Identifier")
pprTyThingCategory (ADataCon _) = ptext SLIT("Data constructor")
251
252
253
254
255
256

instance NamedThing TyThing where	-- Can't put this with the type
  getName (AnId id)     = getName id	-- decl, because the DataCon instance
  getName (ATyCon tc)   = getName tc	-- isn't visible there
  getName (AClass cl)   = getName cl
  getName (ADataCon dc) = dataConName dc
257
\end{code}
258

259

260
261
262
263
264
265
266
267
268
%************************************************************************
%*									*
\subsection{Wired-in type constructors
%*									*
%************************************************************************

We define a few wired-in type constructors here to avoid module knots

\begin{code}
269
270
funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] liftedTypeKind)
	-- You might think that (->) should have type (?? -> ? -> *), and you'd be right
271
272
273
274
275
276
	-- But if we do that we get kind errors when saying
	--	instance Control.Arrow (->)
	-- becuase the expected kind is (*->*->*).  The trouble is that the
	-- expected/actual stuff in the unifier does not go contra-variant, whereas
	-- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in
	-- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
277
278
279
280
281
282

funTyConName = mkWiredInName gHC_PRIM
			(mkOccFS tcName FSLIT("(->)"))
			funTyConKey
			Nothing 		-- No parent object
			(ATyCon funTyCon)	-- Relevant TyCon
283
			BuiltInSyntax
284
285
286
\end{code}


287
288
%************************************************************************
%*									*
289
\subsection{The external interface}
290
291
292
%*									*
%************************************************************************

293
294
295
296
297
@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
defined to use this.  @pprParendType@ is the same, except it puts
parens around the type, except for the atomic cases.  @pprParendType@
works just by setting the initial context precedence very high.

298
\begin{code}
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
data Prec = TopPrec 	-- No parens
	  | FunPrec 	-- Function args; no parens for tycon apps
	  | TyConPrec 	-- Tycon args; no parens for atomic
	  deriving( Eq, Ord )

maybeParen :: Prec -> Prec -> SDoc -> SDoc
maybeParen ctxt_prec inner_prec pretty
  | ctxt_prec < inner_prec = pretty
  | otherwise		   = parens pretty

------------------
pprType, pprParendType :: Type -> SDoc
pprType       ty = ppr_type TopPrec   ty
pprParendType ty = ppr_type TyConPrec ty

------------------
pprPred :: PredType -> SDoc
pprPred (ClassP cls tys) = pprClassPred cls tys
pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty

pprClassPred :: Class -> [Type] -> SDoc
320
321
pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas) 
			<+> sep (map pprParendType tys)
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

pprTheta :: ThetaType -> SDoc
pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))

pprThetaArrow :: ThetaType -> SDoc
pprThetaArrow theta 
  | null theta = empty
  | otherwise  = parens (sep (punctuate comma (map pprPred theta))) <+> ptext SLIT("=>")

------------------
instance Outputable Type where
    ppr ty = pprType ty

instance Outputable PredType where
    ppr = pprPred

instance Outputable name => OutputableBndr (IPName name) where
    pprBndr _ n = ppr n	-- Simple for now

------------------
	-- OK, here's the main printer

ppr_type :: Prec -> Type -> SDoc
ppr_type p (TyVarTy tv)      	      = ppr tv
ppr_type p (PredTy pred)     	      = braces (ppr pred)
347
348
ppr_type p (NoteTy (SynNote ty1) ty2) = ppr_type p ty1 
				  	<+> ifPprDebug (braces $ ptext SLIT("Syn:") <+> pprType ty2)
349
350
351
352
353
354
355
ppr_type p (NoteTy other         ty2) = ppr_type p ty2

ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys

ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
			   pprType t1 <+> ppr_type TyConPrec t2

356
357
358
ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty

359
360
361
362
363
364
365
366
ppr_type p (FunTy ty1 ty2)
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
    maybeParen p FunPrec $
    sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
  where
    ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
    ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]

367
368
ppr_forall_type :: Prec -> Type -> SDoc
ppr_forall_type p ty
369
370
371
372
373
374
  = maybeParen p FunPrec $
    sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
  where
    (tvs,  rho) = split1 [] ty
    (ctxt, tau) = split2 [] rho

375
376
377
    split1 tvs (ForAllTy tv ty)        = split1 (tv:tvs) ty
    split1 tvs (NoteTy (FTVNote _) ty) = split1 tvs ty
    split1 tvs ty		       = (reverse tvs, ty)
378
 
379
380
    split2 ps (NoteTy (FTVNote _) arg 	-- Rather a disgusting case
	       `FunTy` res) 	      = split2 ps (arg `FunTy` res)
381
382
383
    split2 ps (PredTy p `FunTy` ty)   = split2 (p:ps) ty
    split2 ps (NoteTy (FTVNote _) ty) = split2 ps ty
    split2 ps ty		      = (reverse ps, ty)
384
385

ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
386
ppr_tc_app p tc [] 
387
  = ppr_tc tc
388
389
390
391
392
393
394
395
ppr_tc_app p tc [ty] 
  | tc `hasKey` listTyConKey = brackets (pprType ty)
  | tc `hasKey` parrTyConKey = ptext SLIT("[:") <> pprType ty <> ptext SLIT(":]")
ppr_tc_app p tc tys
  | isTupleTyCon tc && tyConArity tc == length tys
  = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
  | otherwise
  = maybeParen p TyConPrec $
396
397
398
    ppr_tc tc <+> sep (map (ppr_type TyConPrec) tys)

ppr_tc :: TyCon -> SDoc
399
400
401
402
403
404
405
ppr_tc tc = parenSymOcc (getOccName tc) (pp_nt_debug <> ppr tc)
  where
   pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc 
				             then ptext SLIT("<recnt>")
					     else ptext SLIT("<nt>"))
	       | otherwise     = empty

406
-------------------
407
pprForAll []  = empty
408
409
410
411
412
413
414
415
pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot

pprTvBndr tv | isLiftedTypeKind kind = ppr tv
	     | otherwise	     = parens (ppr tv <+> dcolon <+> pprKind kind)
	     where
	       kind = tyVarKind tv
\end{code}