TyCon.lhs 43.9 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
5
6

The @TyCon@ datatype
7
8
9

\begin{code}
module TyCon(
batterseapower's avatar
batterseapower committed
10
        -- * Main TyCon data types
11
	TyCon, FieldLabel,
12

13
	AlgTyConRhs(..), visibleDataCons, 
14
        TyConParent(..), 
15
	SynTyConRhs(..),
16

batterseapower's avatar
batterseapower committed
17
        -- ** Constructing TyCons
18
	mkAlgTyCon,
19
	mkClassTyCon,
20
21
	mkFunTyCon,
	mkPrimTyCon,
22
	mkVoidPrimTyCon,
23
	mkLiftedPrimTyCon,
24
25
	mkTupleTyCon,
	mkSynTyCon,
26
27
        mkSuperKindTyCon,
        mkCoercionTyCon,
batterseapower's avatar
batterseapower committed
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
        mkForeignTyCon,

        -- ** Predicates on TyCons
        isAlgTyCon,
        isClassTyCon, isFamInstTyCon, 
        isFunTyCon, 
        isPrimTyCon,
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, 
        isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
        isSuperKindTyCon,
        isCoercionTyCon, isCoercionTyCon_maybe,
        isForeignTyCon,

	isDataTyCon, isProductTyCon, isEnumerationTyCon, 
	isNewTyCon, isAbstractTyCon, isOpenTyCon,
        isUnLiftedTyCon,
	isGadtSyntaxTyCon,
	isTyConAssoc,
	isRecursiveTyCon,
	isHiBootTyCon,
        isImplicitTyCon, tyConHasGenerics,

        -- ** Extracting information out of TyCons
51
	tyConName,
52
53
54
	tyConKind,
	tyConUnique,
	tyConTyVars,
batterseapower's avatar
batterseapower committed
55
56
	tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe,
	tyConFamilySize,
57
	tyConSelIds,
58
	tyConStupidTheta,
59
	tyConArity,
batterseapower's avatar
batterseapower committed
60
61
	tyConClass_maybe,
	tyConFamInst_maybe, tyConFamilyCoercion_maybe,
62
	synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
63
	tyConExtName,		-- External name for foreign types
batterseapower's avatar
batterseapower committed
64
65
66
67
	algTyConRhs,
        newTyConRhs, newTyConEtadRhs, unwrapNewTyCon_maybe, 
        assocTyConArgPoss_maybe,
        tupleTyConBoxity,
68

batterseapower's avatar
batterseapower committed
69
70
71
72
73
        -- ** Manipulating TyCons
	tcExpandTyCon_maybe, coreExpandTyCon_maybe,
	makeTyConAbstract,
	newTyConCo_maybe,
	setTyConArgPoss, 
74

batterseapower's avatar
batterseapower committed
75
76
77
78
        -- * Primitive representations of Types
	PrimRep(..),
	tyConPrimRep,
        primRepSizeW
79
80
) where

81
#include "HsVersions.h"
82

83
import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
84
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
85

86
87
88
89
90
91
import Var
import Class
import BasicTypes
import Name
import PrelNames
import Maybes
92
import Outputable
rrt's avatar
rrt committed
93
import FastString
94
import Constants
95
96
\end{code}

97
98
99
100
101
102
%************************************************************************
%*									*
\subsection{The data type}
%*									*
%************************************************************************

103
\begin{code}
batterseapower's avatar
batterseapower committed
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
-- | Represents type constructors. Type constructors are introduced by things such as:
--
-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@
--
-- 2) Type synonyms: @type Foo = ...@ creates the @Foo@ type constructor
--
-- 3) Newtypes: @newtype Foo a = MkFoo ...@ creates the @Foo@ type constructor of kind @* -> *@
--
-- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor of kind @*@
--
-- 5) Type coercions! This is because we represent a coercion from @t1@ to @t2@ as a 'Type', where
--    that type has kind @t1 :=: t2@. See "Coercion" for more on this
--
-- This data type also encodes a number of primitive, built in type constructors such as those
-- for function and tuple types.
119
data TyCon
batterseapower's avatar
batterseapower committed
120
121
  = -- | The function type constructor, @(->)@
    FunTyCon {
122
123
124
125
126
127
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity
    }

batterseapower's avatar
batterseapower committed
128
129
130
  -- | Algebraic type constructors, which are defined to be those arising @data@ type and @newtype@ declarations.
  -- All these constructors are lifted and boxed. See 'AlgTyConRhs' for more information.
  | AlgTyCon {		
131
132
133
134
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity,
135

batterseapower's avatar
batterseapower committed
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
	tyConTyVars :: [TyVar],		-- ^ The type variables used in the type constructor.
	                                -- Precisely, this list scopes over:
	                                --
	                                -- 1. The 'algTcStupidTheta'
	                                --
					-- 2. The cached types in 'algTyConRhs.NewTyCon'
					-- 
					-- 3. The family instance types if present
					--
					-- Note that it does /not/ scope over the data constructors.

	algTcSelIds :: [Id],  		-- ^ The record selectors of this type (possibly emptys)

	algTcGadtSyntax  :: Bool,	-- ^ Was the data type declared with GADT syntax? If so,
					-- that doesn't mean it's a true GADT; only that the "where"
151
					-- 	form was used. This field is used only to guide
batterseapower's avatar
batterseapower committed
152
153
154
155
					--	pretty-printing
	algTcStupidTheta :: [PredType],	-- ^ The \"stupid theta\" for the data type (always empty for GADTs).
	                                -- A \"stupid theta\" is the context to the left of an algebraic type
	                                -- declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@.
156

batterseapower's avatar
batterseapower committed
157
	algTcRhs :: AlgTyConRhs,	-- ^ Contains information about the data constructors of the algebraic type
158

batterseapower's avatar
batterseapower committed
159
	algTcRec :: RecFlag,		-- ^ Tells us whether the data type is part of a mutually-recursive group or not
160

batterseapower's avatar
batterseapower committed
161
162
	hasGenerics :: Bool,		-- ^ Whether generic (in the -XGenerics sense) to/from functions are
	                                -- available in the exports of the data type's source module.
163

batterseapower's avatar
batterseapower committed
164
165
	algTcParent :: TyConParent	-- ^ Gives the class or family declaration 'TyCon' for derived 'TyCon's
					-- representing class or family instances, respectively. See also 'synTcParent'
166
167
    }

batterseapower's avatar
batterseapower committed
168
  -- | Represents the infinite family of tuple type constructors, @()@, @(a,b)@, @(# a, b #)@ etc.
169
170
171
172
173
174
175
  | TupleTyCon {
	tyConUnique :: Unique,
	tyConName   :: Name,
	tyConKind   :: Kind,
	tyConArity  :: Arity,
	tyConBoxed  :: Boxity,
	tyConTyVars :: [TyVar],
batterseapower's avatar
batterseapower committed
176
	dataCon     :: DataCon, -- ^ Corresponding tuple data constructor
177
178
179
	hasGenerics :: Bool
    }

batterseapower's avatar
batterseapower committed
180
  -- | Represents type synonyms
181
  | SynTyCon {
182
183
184
185
186
187
	tyConUnique  :: Unique,
	tyConName    :: Name,
	tyConKind    :: Kind,
	tyConArity   :: Arity,

	tyConTyVars  :: [TyVar],	-- Bound tyvars
188

batterseapower's avatar
batterseapower committed
189
	synTcRhs     :: SynTyConRhs,	-- ^ Contains information about the expansion of the synonym
190

batterseapower's avatar
batterseapower committed
191
        synTcParent  :: TyConParent     -- ^ Gives the family declaration 'TyCon' of 'TyCon's representing family instances
192

193
194
    }

batterseapower's avatar
batterseapower committed
195
196
197
  -- | Primitive types; cannot be defined in Haskell. This includes the usual suspects (such as @Int#@)
  -- as well as foreign-imported types and kinds
  | PrimTyCon {			
198
199
200
	tyConUnique   :: Unique,
	tyConName     :: Name,
	tyConKind     :: Kind,
201
202
	tyConArity    :: Arity,		-- SLPJ Oct06: I'm not sure what the significance
					--	       of the arity of a primtycon is!
203
204

	primTyConRep  :: PrimRep,
batterseapower's avatar
batterseapower committed
205
206
207
			-- ^ Many primitive tycons are unboxed, but some are
			-- boxed (represented by pointers). This 'PrimRep' holds
			-- that information
208

batterseapower's avatar
batterseapower committed
209
210
211
	isUnLifted   :: Bool,		-- ^ Most primitive tycons are unlifted (may not contain bottom)
					-- but foreign-imported ones may be lifted
	tyConExtName :: Maybe FastString	-- ^ @Just e@ for foreign-imported types, holds the name of the imported thing
212
213
    }

batterseapower's avatar
batterseapower committed
214
215
216
  -- | Type coercions, such as @(:=:)@, @sym@, @trans@, @left@ and @right@.
  -- INVARIANT: coercions are always fully applied
  | CoercionTyCon {	
217
	tyConUnique :: Unique,
218
        tyConName   :: Name,
219
	tyConArity  :: Arity,
220
	coKindFun   :: [Type] -> (Type,Type)
batterseapower's avatar
batterseapower committed
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
    		-- ^ Function that when given a list of the type arguments to the 'TyCon'
    		-- constructs the types that the resulting coercion relates.
    		--
    		-- INVARIANT: 'coKindFun' is always applied to exactly 'tyConArity' args
		-- E.g. for @trans (c1 :: ta=tb) (c2 :: tb=tc)@, the 'coKindFun' returns 
		--	the kind as a pair of types: @(ta, tc)@
    }

  -- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs.
  -- There are only two super-kinds: TY (aka "box"), which is the super-kind of kinds that 
  -- construct types eventually, and CO (aka "diamond"), which is the super-kind of kinds
  -- that just represent coercions.
  --
  -- Super-kinds have no kind themselves, and have arity zero
  | SuperKindTyCon {
236
237
        tyConUnique :: Unique,
        tyConName   :: Name
238
239
    }

batterseapower's avatar
batterseapower committed
240
-- | Names of the fields in an algebraic record type
241
242
type FieldLabel = Name

batterseapower's avatar
batterseapower committed
243
-- | Represents right-hand-sides of 'TyCon's for algebraic types
244
data AlgTyConRhs
245

batterseapower's avatar
batterseapower committed
246
247
  -- | Says that we know nothing about this data type, except that it's represented
  -- by a pointer.  Used when we export a data type abstractly into an .hi file.
248
249
  = AbstractTyCon

batterseapower's avatar
batterseapower committed
250
  -- | Represents an open type family without a fixed right hand
251
  -- side.  Additional instances can appear at any time.
252
  -- 
batterseapower's avatar
batterseapower committed
253
254
255
256
257
258
259
260
  -- These are introduced by either a top level declaration:
  --
  -- > data T a :: *
  --
  -- Or an assoicated data type declaration, within a class declaration:
  --
  -- > class C a b where
  -- >   data T b :: *
261

262
263
  | OpenTyCon {

264
      otArgPoss   :: Maybe [Int]
batterseapower's avatar
batterseapower committed
265
266
267
268
269
270
271
272
273
	-- ^ @Nothing@ iff this is a top-level indexed type family.
	-- @Just ns@ iff this is an associated (not top-level) family
	--
	-- In the latter case, for each 'TyVar' in the associated type declaration, 
	-- @ns@ gives the position of that tyvar in the class argument list (starting 
	-- from 0).
	--
	-- NB: The length of this list is less than the accompanying 'tyConArity' iff 
	-- we have a higher kind signature.
274
    }
275

batterseapower's avatar
batterseapower committed
276
277
  -- | Information about those 'TyCon's derived from a @data@ declaration. This includes 
  -- data types with no constructors at all.
278
279
  | DataTyCon {
	data_cons :: [DataCon],
batterseapower's avatar
batterseapower committed
280
			-- ^ The data type constructors; can be empty if the user declares
281
			--   the type to have no constructors
batterseapower's avatar
batterseapower committed
282
283
284
			--
			-- INVARIANT: Kept in order of increasing 'DataCon' tag
			
285
			--	  (see the tag assignment in DataCon.mkDataCon)
batterseapower's avatar
batterseapower committed
286
287
	is_enum :: Bool 	-- ^ Cached value: is this an enumeration type? (See 'isEnumerationTyCon')
    }
288

batterseapower's avatar
batterseapower committed
289
  -- | Information about those 'TyCon's derived from a @newtype@ declaration
290
  | NewTyCon {
batterseapower's avatar
batterseapower committed
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
	data_con :: DataCon,	-- ^ The unique constructor for the @newtype@. It has no existentials

	nt_rhs :: Type,		-- ^ Cached value: the argument type of the constructor, which
	                        -- is just the representation type of the 'TyCon' (remember that
	                        -- @newtype@s do not exist at runtime so need a different representation
	                        -- type).
	                        --
				-- The free 'TyVar's of this type are the 'tyConTyVars' from the corresponding
				-- 'TyCon'

	nt_etad_rhs :: ([TyVar], Type),
			-- ^ Same as the 'nt_rhs', but this time eta-reduced. Hence the list of 'TyVar's in 
			-- this field may be shorter than the declared arity of the 'TyCon'.
			
			-- See Note [Newtype eta]
306
      
batterseapower's avatar
batterseapower committed
307
308
309
310
311
        nt_co :: Maybe TyCon   -- ^ A 'TyCon' (which is always a 'CoercionTyCon') that can have a 'Coercion' 
                                -- extracted from it to create the @newtype@ from the representation 'Type'.
                                --
                                -- This field is optional for non-recursive @newtype@s only.
                                
312
				-- See Note [Newtype coercions]
313
314
				-- Invariant: arity = #tvs in nt_etad_rhs;
				--	See Note [Newtype eta]
315
316
				-- Watch out!  If any newtypes become transparent
				-- again check Trac #1072.
317
    }
318

batterseapower's avatar
batterseapower committed
319
320
-- | Extract those 'DataCon's that we are able to learn about. Note that visibility in this sense does not
-- correspond to visibility in the context of any particular user program!
321
visibleDataCons :: AlgTyConRhs -> [DataCon]
322
visibleDataCons AbstractTyCon      	      = []
323
visibleDataCons OpenTyCon {}		      = []
324
325
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c })    = [c]
326

batterseapower's avatar
batterseapower committed
327
-- ^ Both type classes as well as family instances imply implicit
328
-- type constructors.  These implicit type constructors refer to their parent
329
-- structure (ie, the class or family from which they derive) using a type of
batterseapower's avatar
batterseapower committed
330
331
-- the following form.  We use 'TyConParent' for both algebraic and synonym 
-- types, but the variant 'ClassTyCon' will only be used by algebraic 'TyCon's.
332
data TyConParent 
batterseapower's avatar
batterseapower committed
333
334
  = -- | An ordinary type constructor has no parent.
    NoParentTyCon
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
335

batterseapower's avatar
batterseapower committed
336
337
  -- | Type constructors representing a class dictionary.
  | ClassTyCon      	
338
	Class		-- INVARIANT: the classTyCon of this Class is the current tycon
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
339

batterseapower's avatar
batterseapower committed
340
341
342
343
344
345
346
347
348
349
350
351
352
353
  -- | Type constructors representing an instance of a type family. Parameters:
  --
  --  1) The type family in question
  --
  --  2) Instance types; free variables are the 'tyConTyVars'
  --  of the current 'TyCon' (not the family one). INVARIANT: 
  --  the number of types matches the arity of the family 'TyCon'
  --
  --  3) A 'CoercionTyCon' identifying the representation
  --  type with the type instance family
  | FamilyTyCon
	TyCon
	[Type]
	TyCon  -- c.f. Note [Newtype coercions]
354
355

	--
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
356
357
	-- E.g.  data intance T [a] = ...
	-- gives a representation tycon:
358
359
360
	--	data :R7T a = ...
	-- 	axiom co a :: T [a] ~ :R7T a
	-- with :R7T's algTcParent = FamilyTyCon T [a] co
361

batterseapower's avatar
batterseapower committed
362
363
-- | Checks the invariants of a 'TyConParent' given the appropriate type class name, if any
okParent :: Name -> TyConParent -> Bool
twanvl's avatar
twanvl committed
364
365
366
okParent _       NoParentTyCon                   = True
okParent tc_name (ClassTyCon cls)                = tyConName (classTyCon cls) == tc_name
okParent _       (FamilyTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length tys
367
368

--------------------
batterseapower's avatar
batterseapower committed
369
370

-- | Information pertaining to the expansion of a type synonym (@type@)
371
data SynTyConRhs
batterseapower's avatar
batterseapower committed
372
373
374
375
376
377
  = OpenSynTyCon Kind	        
		 (Maybe [Int])  -- ^ A Type family synonym. The /result/ 'Kind' is
		                -- given for associated families, and in this case the
		                -- list of @Int@s is not empty, and for each 'TyVar' in
				-- the associated type declaration, it gives the position
				-- of that 'TyVar' in the class argument list (starting
378
				-- from 0). 
batterseapower's avatar
batterseapower committed
379
380
381
				--
				-- NB: The length of this list will be less than 'tyConArity' iff
				-- the family has a higher kind signature.
382

batterseapower's avatar
batterseapower committed
383
384
385
  | SynonymTyCon Type   -- ^ The synonym mentions head type variables. It acts as a
			-- template for the expansion when the 'TyCon' is applied to some
			-- types.
386
387
\end{code}

388
389
390
391
392
393
Note [Newtype coercions]
~~~~~~~~~~~~~~~~~~~~~~~~
The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
which is used for coercing from the representation type of the
newtype, to the newtype itself. For example,

394
   newtype T a = MkT (a -> a)
395

396
397
398
399
400
401
402
403
404
405
406
407
the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
own; it basically has its own typing rule for the fully-applied
version.  If the newtype T has k type variables then CoT has arity at
most k.  In the case that the right hand side is a type application
ending with the same type variables as the left hand side, we
"eta-contract" the coercion.  So if we had

   newtype S a = MkT [a]

then we would generate the arity 0 coercion CoS : S :=: [].  The
primary reason we do this is to make newtype deriving cleaner.
408

409
In the paper we'd write
410
	axiom CoT : (forall t. T t) :=: (forall t. [t])
411
412
413
414
and then when we used CoT at a particular type, s, we'd say
	CoT @ s
which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
415
But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
416
417
(like instCoercionTyCon, symCoercionTyCon etc), which must always
be saturated, but which encodes as
418
	TyConApp CoT [s]
419
420
In the vocabulary of the paper it's as if we had axiom declarations
like
421
	axiom CoT t :  T t :=: [t]
422

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
Note [Newtype eta]
~~~~~~~~~~~~~~~~~~
Consider
	newtype Parser m a = MkParser (Foogle m a)
Are these two types equal (to Core)?
	Monad (Parser m) 
	Monad (Foogle m)
Well, yes.  But to see that easily we eta-reduce the RHS type of
Parser, in this case to ([], Froogle), so that even unsaturated applications
of Parser will work right.  This eta reduction is done when the type 
constructor is built, and cached in NewTyCon.  The cached field is
only used in coreExpandTyCon_maybe.
 
Here's an example that I think showed up in practice
Source code:
	newtype T a = MkT [a]
	newtype Foo m = MkFoo (forall a. m a -> Int)

	w1 :: Foo []
	w1 = ...
	
	w2 :: Foo T
	w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)

447
After desugaring, and discarding the data constructors for the newtypes,
448
449
450
451
452
we get:
	w2 :: Foo T
	w2 = w1
And now Lint complains unless Foo T == Foo [], and that requires T==[]

453
454
455
456
457
458
459
460
This point carries over to the newtype coercion, because we need to
say 
	w2 = w1 `cast` Foo CoT

so the coercion tycon CoT must have 
	kind:    T ~ []
 and	arity:   0

461

462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
Note [Indexed data types] (aka data type families)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   See also Note [Wrappers for data instance tycons] in MkId.lhs

Consider
	data family T a

	data instance T (b,c) where
	  T1 :: b -> c -> T (b,c)

Then
  * T is the "family TyCon"

  * We make "representation TyCon" :R1T, thus:
	data :R1T b c where
	  T1 ::	forall b c. b -> c -> :R1T b c

  * It has a top-level coercion connecting it to the family TyCon

	axiom :Co:R1T b c : T (b,c) ~ :R1T b c

  * The data contructor T1 has a wrapper (which is what the source-level
    "T1" invokes):

	$WT1 :: forall b c. b -> c -> T (b,c)
	$WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c)

  * The representation TyCon :R1T has an AlgTyConParent of

	FamilyTyCon T [(b,c)] :Co:R1T



495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
%************************************************************************
%*									*
\subsection{PrimRep}
%*									*
%************************************************************************

A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
MachRep (see cmm/MachOp), although each of these types has a distinct
and clearly defined purpose:

  - A PrimRep is a CgRep + information about signedness + information
    about primitive pointers (AddrRep).  Signedness and primitive
    pointers are required when passing a primitive type to a foreign
    function, but aren't needed for call/return conventions of Haskell
    functions.

  - A MachRep is a basic machine type (non-void, doesn't contain
    information on pointerhood or signedness, but contains some
    reps that don't have corresponding Haskell types).

\begin{code}
batterseapower's avatar
batterseapower committed
516
517
518
-- | A 'PrimRep' is an abstraction of a type.  It contains information that
-- the code generator needs in order to pass arguments, return results,
-- and store values of this type.
519
520
521
data PrimRep
  = VoidRep
  | PtrRep
batterseapower's avatar
batterseapower committed
522
523
524
525
526
  | IntRep		-- ^ Signed, word-sized value
  | WordRep		-- ^ Unsigned, word-sized value
  | Int64Rep		-- ^ Signed, 64 bit value (with 32-bit words only)
  | Word64Rep		-- ^ Unsigned, 64 bit value (with 32-bit words only)
  | AddrRep		-- ^ A pointer, but /not/ to a Haskell value (use 'PtrRep')
527
528
  | FloatRep
  | DoubleRep
529
530
531
532
533
  deriving( Eq, Show )

instance Outputable PrimRep where
  ppr r = text (show r)

batterseapower's avatar
batterseapower committed
534
-- | Find the size of a 'PrimRep', in words
535
536
537
538
539
540
541
542
543
544
primRepSizeW :: PrimRep -> Int
primRepSizeW IntRep   = 1
primRepSizeW WordRep  = 1
primRepSizeW Int64Rep = wORD64_SIZE `quot` wORD_SIZE
primRepSizeW Word64Rep= wORD64_SIZE `quot` wORD_SIZE
primRepSizeW FloatRep = 1    -- NB. might not take a full word
primRepSizeW DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE
primRepSizeW AddrRep  = 1
primRepSizeW PtrRep   = 1
primRepSizeW VoidRep  = 0
545
\end{code}
546

547
548
549
550
551
%************************************************************************
%*									*
\subsection{TyCon Construction}
%*									*
%************************************************************************
552

553
554
555
556
557
Note: the TyCon constructors all take a Kind as one argument, even though
they could, in principle, work out their Kind from their other arguments.
But to do so they need functions from Types, and that makes a nasty
module mutual-recursion.  And they aren't called from many places.
So we compromise, and move their Kind calculation to the call site.
558

559
\begin{code}
batterseapower's avatar
batterseapower committed
560
561
562
-- | Given the name of the function type constructor and it's kind, create the
-- corresponding 'TyCon'. It is reccomended to use 'TypeRep.funTyCon' if you want 
-- this functionality
563
mkFunTyCon :: Name -> Kind -> TyCon
564
565
566
567
568
569
570
mkFunTyCon name kind 
  = FunTyCon { 
	tyConUnique = nameUnique name,
	tyConName   = name,
	tyConKind   = kind,
	tyConArity  = 2
    }
571

batterseapower's avatar
batterseapower committed
572
573
-- | This is the making of an algebraic 'TyCon'. Notably, you have to pass in the generic (in the -XGenerics sense)
-- information about the type constructor - you can get hold of it easily (see Generics module)
twanvl's avatar
twanvl committed
574
mkAlgTyCon :: Name
batterseapower's avatar
batterseapower committed
575
576
577
578
579
           -> Kind              -- ^ Kind of the resulting 'TyCon'
           -> [TyVar]           -- ^ 'TyVar's scoped over: see 'tyConTyVars'. Arity is inferred from the length of this list
           -> [PredType]        -- ^ Stupid theta: see 'algTcStupidTheta'
           -> AlgTyConRhs       -- ^ Information about dat aconstructors
           -> [Id]              -- ^ Selector 'Id's
twanvl's avatar
twanvl committed
580
           -> TyConParent
batterseapower's avatar
batterseapower committed
581
582
583
           -> RecFlag           -- ^ Is the 'TyCon' recursive?
           -> Bool              -- ^ Does it have generic functions? See 'hasGenerics'
           -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?
twanvl's avatar
twanvl committed
584
           -> TyCon
585
mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
586
  = AlgTyCon {	
587
588
589
590
591
	tyConName 	 = name,
	tyConUnique	 = nameUnique name,
	tyConKind	 = kind,
	tyConArity	 = length tyvars,
	tyConTyVars	 = tyvars,
592
	algTcStupidTheta = stupid,
593
	algTcRhs         = rhs,
594
	algTcSelIds	 = sel_ids,
595
	algTcParent	 = ASSERT( okParent name parent ) parent,
596
	algTcRec	 = is_rec,
597
	algTcGadtSyntax  = gadt_syn,
598
	hasGenerics = gen_info
599
600
    }

batterseapower's avatar
batterseapower committed
601
-- | Simpler specialization of 'mkAlgTyCon' for classes
twanvl's avatar
twanvl committed
602
mkClassTyCon :: Name -> Kind -> [TyVar] -> AlgTyConRhs -> Class -> RecFlag -> TyCon
603
604
mkClassTyCon name kind tyvars rhs clas is_rec =
  mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
605

batterseapower's avatar
batterseapower committed
606
607
608
609
610
611
612
613
mkTupleTyCon :: Name 
             -> Kind    -- ^ Kind of the resulting 'TyCon'
             -> Arity   -- ^ Arity of the tuple
             -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'
             -> DataCon 
             -> Boxity  -- ^ Whether the tuple is boxed or unboxed
             -> Bool    -- ^ Does it have generic functions? See 'hasGenerics'
             -> TyCon
614
mkTupleTyCon name kind arity tyvars con boxed gen_info
615
616
617
618
619
620
621
  = TupleTyCon {
	tyConUnique = nameUnique name,
	tyConName = name,
	tyConKind = kind,
	tyConArity = arity,
	tyConBoxed = boxed,
	tyConTyVars = tyvars,
622
	dataCon = con,
623
	hasGenerics = gen_info
624
625
    }

batterseapower's avatar
batterseapower committed
626
627
628
629
630
631
632
633
634
-- ^ Foreign-imported (.NET) type constructors are represented
-- as primitive, but /lifted/, 'TyCons' for now. They are lifted
-- because the Haskell type @T@ representing the (foreign) .NET
-- type @T@ is actually implemented (in ILX) as a @thunk<T>@
mkForeignTyCon :: Name 
               -> Maybe FastString -- ^ Name of the foreign imported thing, maybe
               -> Kind 
               -> Arity 
               -> TyCon
635
mkForeignTyCon name ext_name kind arity
636
  = PrimTyCon {
637
638
639
640
	tyConName    = name,
	tyConUnique  = nameUnique name,
	tyConKind    = kind,
	tyConArity   = arity,
641
	primTyConRep = PtrRep, -- they all do
rrt's avatar
rrt committed
642
643
	isUnLifted   = False,
	tyConExtName = ext_name
644
645
646
    }


batterseapower's avatar
batterseapower committed
647
-- | Create an unlifted primitive 'TyCon', such as @Int#@
twanvl's avatar
twanvl committed
648
mkPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
649
650
mkPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep True  
651

batterseapower's avatar
batterseapower committed
652
-- | Create the special void 'TyCon' which is unlifted and has 'VoidRep'
twanvl's avatar
twanvl committed
653
mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon
654
655
mkVoidPrimTyCon name kind arity 
  = mkPrimTyCon' name kind arity VoidRep True  
656

batterseapower's avatar
batterseapower committed
657
-- | Create a lifted primitive 'TyCon' such as @RealWorld@
twanvl's avatar
twanvl committed
658
mkLiftedPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
659
660
mkLiftedPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep False
661

twanvl's avatar
twanvl committed
662
mkPrimTyCon' :: Name  -> Kind -> Arity -> PrimRep -> Bool -> TyCon
663
mkPrimTyCon' name kind arity rep is_unlifted
664
665
666
667
668
669
  = PrimTyCon {
	tyConName    = name,
	tyConUnique  = nameUnique name,
	tyConKind    = kind,
	tyConArity   = arity,
	primTyConRep = rep,
670
	isUnLifted   = is_unlifted,
rrt's avatar
rrt committed
671
	tyConExtName = Nothing
672
673
    }

batterseapower's avatar
batterseapower committed
674
-- | Create a type synonym 'TyCon'
twanvl's avatar
twanvl committed
675
mkSynTyCon :: Name -> Kind -> [TyVar] -> SynTyConRhs -> TyConParent -> TyCon
676
mkSynTyCon name kind tyvars rhs parent
677
678
679
680
  = SynTyCon {	
	tyConName = name,
	tyConUnique = nameUnique name,
	tyConKind = kind,
681
	tyConArity = length tyvars,
682
	tyConTyVars = tyvars,
683
684
	synTcRhs = rhs,
        synTcParent = parent
685
    }
686

batterseapower's avatar
batterseapower committed
687
-- | Create a coercion 'TyCon'
twanvl's avatar
twanvl committed
688
mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon
689
690
691
692
693
694
695
696
mkCoercionTyCon name arity kindRule
  = CoercionTyCon {
        tyConName = name,
        tyConUnique = nameUnique name,
        tyConArity = arity,
        coKindFun = kindRule
    }

batterseapower's avatar
batterseapower committed
697
698
-- | Create a super-kind 'TyCon'
mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero
699
700
701
702
703
mkSuperKindTyCon name
  = SuperKindTyCon {
        tyConName = name,
        tyConUnique = nameUnique name
  }
704
\end{code}
705

706
\begin{code}
707
isFunTyCon :: TyCon -> Bool
708
709
isFunTyCon (FunTyCon {}) = True
isFunTyCon _             = False
710

batterseapower's avatar
batterseapower committed
711
-- | Test if the 'TyCon' is algebraic but abstract (invisible data constructors)
712
isAbstractTyCon :: TyCon -> Bool
713
isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
714
715
isAbstractTyCon _ = False

batterseapower's avatar
batterseapower committed
716
-- | Make an algebraic 'TyCon' abstract. Panics if the supplied 'TyCon' is not algebraic
717
718
719
720
makeTyConAbstract :: TyCon -> TyCon
makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)

batterseapower's avatar
batterseapower committed
721
-- | Does this 'TyCon' represent something that cannot be defined in Haskell?
722
isPrimTyCon :: TyCon -> Bool
723
724
isPrimTyCon (PrimTyCon {}) = True
isPrimTyCon _              = False
725

batterseapower's avatar
batterseapower committed
726
727
-- | Is this 'TyCon' unlifted (i.e. cannot contain bottom)? Note that this can only
-- be true for primitive and unboxed-tuple 'TyCon's
728
isUnLiftedTyCon :: TyCon -> Bool
729
730
731
isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
isUnLiftedTyCon _    				        = False
732

batterseapower's avatar
batterseapower committed
733
-- | Returns @True@ if the supplied 'TyCon' resulted from either a @data@ or @newtype@ declaration
734
isAlgTyCon :: TyCon -> Bool
735
736
isAlgTyCon (AlgTyCon {})   = True
isAlgTyCon (TupleTyCon {}) = True
twanvl's avatar
twanvl committed
737
isAlgTyCon _               = False
sof's avatar
sof committed
738

739
isDataTyCon :: TyCon -> Bool
batterseapower's avatar
batterseapower committed
740
741
742
743
744
745
746
-- ^ Returns @True@ for data types that are /definitely/ represented by 
-- heap-allocated constructors.  These are scrutinised by Core-level 
-- @case@ expressions, and they get info tables allocated for them.
-- 
-- Generally, the function will be true for all @data@ types and false
-- for @newtype@s, unboxed tuples and type family 'TyCon's. But it is
-- not guarenteed to return @True@ in all cases that it could.
747
-- 
batterseapower's avatar
batterseapower committed
748
749
-- NB: for a data type family, only the /instance/ 'TyCon's
--     get an info table.  The family declaration 'TyCon' does not
twanvl's avatar
twanvl committed
750
isDataTyCon (AlgTyCon {algTcRhs = rhs})
751
  = case rhs of
752
        OpenTyCon {}  -> False
753
754
	DataTyCon {}  -> True
	NewTyCon {}   -> False
755
	AbstractTyCon -> False	 -- We don't know, so return False
756
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
twanvl's avatar
twanvl committed
757
isDataTyCon _ = False
758

batterseapower's avatar
batterseapower committed
759
-- | Is this 'TyCon' that for a @newtype@
760
isNewTyCon :: TyCon -> Bool
761
isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
twanvl's avatar
twanvl committed
762
isNewTyCon _                                   = False
763

batterseapower's avatar
batterseapower committed
764
765
766
-- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it expands
-- into, and (possibly) a coercion from the representation type to the @newtype@.
-- Returns @Nothing@ if this is not possible.
767
768
769
770
771
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs, 
				 algTcRhs = NewTyCon { nt_co = mb_co, 
						       nt_rhs = rhs }})
			   = Just (tvs, rhs, mb_co)
twanvl's avatar
twanvl committed
772
unwrapNewTyCon_maybe _     = Nothing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
773

774
isProductTyCon :: TyCon -> Bool
batterseapower's avatar
batterseapower committed
775
776
777
778
779
-- | A /product/ 'TyCon' must both:
--
-- 1. Have /one/ constructor
-- 
-- 2. /Not/ be existential
780
-- 
batterseapower's avatar
batterseapower committed
781
782
-- However other than this there are few restrictions: they may be @data@ or @newtype@ 
-- 'TyCon's of any boxity and may even be recursive.
783
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
784
785
786
				    DataTyCon{ data_cons = [data_con] } 
						-> isVanillaDataCon data_con
				    NewTyCon {}	-> True
twanvl's avatar
twanvl committed
787
				    _           -> False
788
isProductTyCon (TupleTyCon {})  = True   
twanvl's avatar
twanvl committed
789
isProductTyCon _                = False
790

batterseapower's avatar
batterseapower committed
791
-- | Is this a 'TyCon' representing a type synonym (@type@)?
792
isSynTyCon :: TyCon -> Bool
793
794
isSynTyCon (SynTyCon {}) = True
isSynTyCon _		 = False
795

796
797
798
799
-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
--
batterseapower's avatar
batterseapower committed
800
801

-- | Is this a synonym 'TyCon' that can have no further instances appear?
802
803
804
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)

batterseapower's avatar
batterseapower committed
805
-- | Is this a synonym 'TyCon' that can have may have further instances appear?
806
807
808
isOpenSynTyCon :: TyCon -> Bool
isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon

batterseapower's avatar
batterseapower committed
809
-- | Is this an algebraic 'TyCon' declared with the GADT syntax?
810
811
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
twanvl's avatar
twanvl committed
812
isGadtSyntaxTyCon _                                    = False
813

batterseapower's avatar
batterseapower committed
814
-- | Is this an algebraic 'TyCon' which is just an enumeration of values?
815
isEnumerationTyCon :: TyCon -> Bool
816
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
twanvl's avatar
twanvl committed
817
isEnumerationTyCon _                                                   = False
818

batterseapower's avatar
batterseapower committed
819
-- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear?
820
isOpenTyCon :: TyCon -> Bool
821
822
823
isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}    }) = True
isOpenTyCon _					     = False
824

batterseapower's avatar
batterseapower committed
825
826
827
-- | Extract the mapping from 'TyVar' indexes to indexes in the corresponding family
-- argument lists form an open 'TyCon' of any sort, if the given 'TyCon' is indeed
-- such a beast and that information is available
828
assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
829
830
831
832
assocTyConArgPoss_maybe (AlgTyCon { 
			   algTcRhs = OpenTyCon {otArgPoss = poss}})  = poss
assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss
assocTyConArgPoss_maybe _ = Nothing
833

batterseapower's avatar
batterseapower committed
834
835
-- | Are we able to extract informationa 'TyVar' to class argument list
-- mappping from a given 'TyCon'?
836
837
isTyConAssoc :: TyCon -> Bool
isTyConAssoc = isJust . assocTyConArgPoss_maybe
838

batterseapower's avatar
batterseapower committed
839
840
-- | Sets up a 'TyVar' to family argument-list mapping in the given 'TyCon' if it is
-- an open 'TyCon'. Panics otherwise
841
setTyConArgPoss :: TyCon -> [Int] -> TyCon
842
843
844
845
setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs })               poss = 
  tc { algTcRhs = rhs {otArgPoss = Just poss} }
setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss = 
  tc { synTcRhs = OpenSynTyCon ki (Just poss) }
846
setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
847

848
849
850
-- The unit tycon didn't used to be classed as a tuple tycon
-- but I thought that was silly so I've undone it
-- If it can't be for some reason, it should be a AlgTyCon
batterseapower's avatar
batterseapower committed
851
852
isTupleTyCon :: TyCon -> Bool
-- ^ Does this 'TyCon' represent a tuple?
853
--
batterseapower's avatar
batterseapower committed
854
855
-- NB: when compiling @Data.Tuple@, the tycons won't reply @True@ to
-- 'isTupleTyCon', becuase they are built as 'AlgTyCons'.  However they
856
857
-- get spat into the interface file as tuple tycons, so I don't think
-- it matters.
858
isTupleTyCon (TupleTyCon {}) = True
twanvl's avatar
twanvl committed
859
isTupleTyCon _               = False
860

batterseapower's avatar
batterseapower committed
861
-- | Is this the 'TyCon' for an unboxed tuple?
862
isUnboxedTupleTyCon :: TyCon -> Bool
863
isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
twanvl's avatar
twanvl committed
864
isUnboxedTupleTyCon _                                  = False
865

batterseapower's avatar
batterseapower committed
866
-- | Is this the 'TyCon' for a boxed tuple?
867
isBoxedTupleTyCon :: TyCon -> Bool
868
isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
twanvl's avatar
twanvl committed
869
isBoxedTupleTyCon _                                  = False
870

batterseapower's avatar
batterseapower committed
871
872
-- | Extract the boxity of the given 'TyCon', if it is a 'TupleTyCon'.
-- Panics otherwise
twanvl's avatar
twanvl committed
873
tupleTyConBoxity :: TyCon -> Boxity
874
875
tupleTyConBoxity tc = tyConBoxed tc

batterseapower's avatar
batterseapower committed
876
-- | Is this a recursive 'TyCon'?
877
isRecursiveTyCon :: TyCon -> Bool
878
isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
twanvl's avatar
twanvl committed
879
isRecursiveTyCon _                                 = False
880

batterseapower's avatar
batterseapower committed
881
-- | Did this 'TyCon' originate from type-checking a .h*-boot file?
882
883
isHiBootTyCon :: TyCon -> Bool
-- Used for knot-tying in hi-boot files
884
isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
twanvl's avatar
twanvl committed
885
isHiBootTyCon _                                     = False
886

batterseapower's avatar
batterseapower committed
887
-- | Is this the 'TyCon' of a foreign-imported type constructor?
888
isForeignTyCon :: TyCon -> Bool
889
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
twanvl's avatar
twanvl committed
890
isForeignTyCon _                                   = False
891

batterseapower's avatar
batterseapower committed
892
-- | Is this a super-kind 'TyCon'?
893
894
isSuperKindTyCon :: TyCon -> Bool
isSuperKindTyCon (SuperKindTyCon {}) = True
twanvl's avatar
twanvl committed
895
isSuperKindTyCon _                   = False
896

batterseapower's avatar
batterseapower committed
897
898
899
-- | Attempt to pull a 'TyCon' apart into the arity and 'coKindFun' of
-- a coercion 'TyCon'. Returns @Nothing@ if the 'TyCon' is not of the
-- appropriate kind
900
isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
901
902
isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
  = Just (ar, rule)
twanvl's avatar
twanvl committed
903
isCoercionTyCon_maybe _ = Nothing
904

batterseapower's avatar
batterseapower committed
905
-- | Is this a 'TyCon' that represents a coercion?
906
isCoercionTyCon :: TyCon -> Bool
907
isCoercionTyCon (CoercionTyCon {}) = True
twanvl's avatar
twanvl committed
908
isCoercionTyCon _                  = False
909

batterseapower's avatar
batterseapower committed
910
-- | Identifies implicit tycons that, in particular, do not go into interface
911
912
913
-- files (because they are implicitly reconstructed when the interface is
-- read).
--
batterseapower's avatar
batterseapower committed
914
-- Note that:
915
--
batterseapower's avatar
batterseapower committed
916
-- * Associated families are implicit, as they are re-constructed from
917
918
--   the class declaration in which they reside, and 
--
batterseapower's avatar
batterseapower committed
919
920
-- * Family instances are /not/ implicit as they represent the instance body
--   (similar to a @dfun@ does that for a class instance).
921
isImplicitTyCon :: TyCon -> Bool
922
923
924
925
926
927
isImplicitTyCon tycon | isTyConAssoc tycon           = True
		      | isSynTyCon tycon	     = False
		      | isAlgTyCon tycon	     = isClassTyCon tycon ||
						       isTupleTyCon tycon
isImplicitTyCon _other                               = True
        -- catches: FunTyCon, PrimTyCon, 
928
        -- CoercionTyCon, SuperKindTyCon
929
930
\end{code}

931
932
933
934
935
936
937
938

-----------------------------------------------
--	Expand type-constructor applications
-----------------------------------------------

\begin{code}
tcExpandTyCon_maybe, coreExpandTyCon_maybe 
	:: TyCon 
batterseapower's avatar
batterseapower committed
939
940
941
942
943
944
945
946
	-> [Type]			-- ^ Arguments to 'TyCon'
	-> Maybe ([(TyVar,Type)], 	
		  Type,			
		  [Type])		-- ^ Returns a 'TyVar' substitution, the body type
                                        -- of the synonym (not yet substituted) and any arguments
                                        -- remaining from the application

-- ^ Used to create the view the /typechecker/ has on 'TyCon's. We expand (closed) synonyms only, cf. 'coreExpandTyCon_maybe'
947
948
tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
			       synTcRhs = SynonymTyCon rhs }) tys
949
   = expand tvs rhs tys
twanvl's avatar
twanvl committed
950
tcExpandTyCon_maybe _ _ = Nothing
951
952

---------------
953

batterseapower's avatar
batterseapower committed
954
955
-- ^ Used to create the view /Core/ has on 'TyCon's. We expand not only closed synonyms like 'tcExpandTyCon_maybe',
-- but also non-recursive @newtype@s
956
coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,	-- Not recursive
957
         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
958
959
960
961
   = case etad_rhs of	-- Don't do this in the pattern match, lest we accidentally
			-- match the etad_rhs of a *recursive* newtype
	(tvs,rhs) -> expand tvs rhs tys

962
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
963
964


965
966
967
968
969
970
971
972
973
974
975
976
977
----------------
expand	:: [TyVar] -> Type 			-- Template
	-> [Type]				-- Args
	-> Maybe ([(TyVar,Type)], Type, [Type])	-- Expansion
expand tvs rhs tys
  = case n_tvs `compare` length tys of
	LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
	EQ -> Just (tvs `zip` tys, rhs, [])
	GT -> Nothing
   where
     n_tvs = length tvs
\end{code}

978
\begin{code}
batterseapower's avatar
batterseapower committed
979
-- | Does this 'TyCon' have any generic to/from functions available? See also 'hasGenerics'
980
981
982
tyConHasGenerics :: TyCon -> Bool
tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
twanvl's avatar
twanvl committed
983
tyConHasGenerics _                               = False        -- Synonyms
984

batterseapower's avatar
batterseapower committed
985
986
-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
-- could be found
987
tyConDataCons :: TyCon -> [DataCon]
988
989
990
-- It's convenient for tyConDataCons to return the
-- empty list for type synonyms etc
tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
991

batterseapower's avatar
batterseapower committed
992
993
-- | Determine the 'DataCon's originating from the given 'TyCon', if the 'TyCon' is the
-- sort that can have any constructors (note: this does not include abstract algebraic types)
994
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
995
996
997
tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
tyConDataCons_maybe (TupleTyCon {dataCon = con})	       		   = Just [con]
twanvl's avatar
twanvl committed
998
tyConDataCons_maybe _                                                      = Nothing
999

batterseapower's avatar
batterseapower committed
1000
1001
-- | Determine the number of value constructors a 'TyCon' has. Panics if the 'TyCon'
-- is not algebraic or a tuple
1002
tyConFamilySize  :: TyCon -> Int
1003
1004
1005
tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
  length cons
tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
1006
tyConFamilySize (AlgTyCon   {algTcRhs = OpenTyCon {}})                 = 0
1007
tyConFamilySize (TupleTyCon {})	 		                       = 1
1008
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
1009

batterseapower's avatar
batterseapower committed
1010
-- | Extract the record selector 'Id's from an algebraic 'TyCon' and returns the empty list otherwise
1011
tyConSelIds :: TyCon -> [Id]
1012
tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
twanvl's avatar
twanvl committed
1013
tyConSelIds _                             = []
1014

batterseapower's avatar
batterseapower committed
1015
1016
-- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple
-- 'TyCon'. Panics for any other sort of 'TyCon'
1017
1018
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
1019
algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
1020
algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
1021
1022
1023
\end{code}

\begin{code}
batterseapower's avatar
batterseapower committed
1024
1025
-- | Extract the bound type variables and type expansion of a type synonym 'TyCon'. Panics if the
-- 'TyCon' is not a synonym
1026
newTyConRhs :: TyCon -> ([TyVar], Type)
1027
newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
1028
newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
1029

batterseapower's avatar
batterseapower committed
1030
1031
-- | Extract the bound type variables and type expansion of an eta-contracted type synonym 'TyCon'.
-- Panics if the 'TyCon' is not a synonym
1032
1033
1034
1035
newTyConEtadRhs :: TyCon -> ([TyVar], Type)
newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)

batterseapower's avatar
batterseapower committed
1036
1037
1038
-- | Extracts the @newtype@ coercion from such a 'TyCon', which can be used to construct something
-- with the @newtype@s type from its representation type (right hand side). If the supplied 'TyCon'
-- is not a @newtype@, returns @Nothing@
1039
1040
1041
newTyConCo_maybe :: TyCon -> Maybe TyCon
newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
newTyConCo_maybe _						 = Nothing
1042

batterseapower's avatar
batterseapower committed
1043
-- | Find the primitive representation of a 'TyCon'
1044
tyConPrimRep :: TyCon -> PrimRep
1045
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
1046
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
1047
1048
\end{code}

1049
\begin{code}
batterseapower's avatar
batterseapower committed
1050
1051
-- | Find the \"stupid theta\" of the 'TyCon'. A \"stupid theta\" is the context to the left of
-- an algebraic type declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@
1052
tyConStupidTheta :: TyCon -> [PredType]
1053
1054
1055
tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
tyConStupidTheta (TupleTyCon {})			= []
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
1056
1057
\end{code}

1058
\begin{code}
batterseapower's avatar
batterseapower committed
1059
1060
-- | Extract the 'TyVar's bound by a type synonym and the corresponding (unsubstituted) right hand side.
-- If the given 'TyCon' is not a type synonym, panics
1061
synTyConDefn :: TyCon -> ([TyVar], Type)
1062
1063
synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty}) 
  = (tyvars, ty)
1064
1065
synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)

batterseapower's avatar
batterseapower committed
1066
1067
-- | Extract the information pertaining to the right hand side of a type synonym (@type@) declaration. Panics
-- if the given 'TyCon' is not a type synonym
1068
1069
1070
1071
synTyConRhs :: TyCon -> SynTyConRhs
synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
synTyConRhs tc				= pprPanic "synTyConRhs" (ppr tc)

batterseapower's avatar
batterseapower committed
1072
1073
1074
-- | Find the expansion of the type synonym represented by the given 'TyCon'. The free variables of this
-- type will typically include those 'TyVar's bound by the 'TyCon'. Panics if the 'TyCon' is not that of
-- a type synonym
1075
1076
1077
1078
1079
synTyConType :: TyCon -> Type
synTyConType tc = case synTcRhs tc of
		    SynonymTyCon t -> t
		    _		   -> pprPanic "synTyConType" (ppr tc)

batterseapower's avatar
batterseapower committed
1080
-- | Find the 'Kind' of an open type synonym. Panics if the 'TyCon' is not an open type synonym
1081
synTyConResKind :: TyCon -> Kind
1082
synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind
1083
synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
1084
1085
1086
\end{code}

\begin{code}
batterseapower's avatar
batterseapower committed
1087
1088
1089
1090
-- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ type with one
-- alternative, a tuple type or a @newtype@ then that constructor is returned. If the 'TyCon'
-- has more than one constructor, or represents a primitive or function type constructor then
-- @Nothing@ is returned. In any other case, the function panics
1091
1092
1093
1094